<?xml version="1.0" encoding="UTF-8"?><rss version="2.0"
	xmlns:content="http://purl.org/rss/1.0/modules/content/"
	xmlns:wfw="http://wellformedweb.org/CommentAPI/"
	xmlns:dc="http://purl.org/dc/elements/1.1/"
	xmlns:atom="http://www.w3.org/2005/Atom"
	xmlns:sy="http://purl.org/rss/1.0/modules/syndication/"
	xmlns:slash="http://purl.org/rss/1.0/modules/slash/"
	>

<channel>
	<title>stan &#8211; Weird Data Science</title>
	<atom:link href="https://www.weirddatascience.net/category/stan/feed/" rel="self" type="application/rss+xml" />
	<link>https://www.weirddatascience.net</link>
	<description>Paranormal Distributions. Cyclopean Data. Esoteric Regression.</description>
	<lastBuildDate>Sat, 15 Nov 2025 14:01:45 +0000</lastBuildDate>
	<language>en-GB</language>
	<sy:updatePeriod>
	hourly	</sy:updatePeriod>
	<sy:updateFrequency>
	1	</sy:updateFrequency>
	<generator>https://wordpress.org/?v=6.9.4</generator>
<site xmlns="com-wordpress:feed-additions:1">143387998</site>	<item>
		<title>Bayes vs. the Invaders (Redivivus)</title>
		<link>https://www.weirddatascience.net/2025/11/15/bayes-vs-the-invaders-redivivus/</link>
					<comments>https://www.weirddatascience.net/2025/11/15/bayes-vs-the-invaders-redivivus/#respond</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Sat, 15 Nov 2025 10:50:27 +0000</pubDate>
				<category><![CDATA[event]]></category>
		<category><![CDATA[scraping]]></category>
		<category><![CDATA[stan]]></category>
		<category><![CDATA[ufo]]></category>
		<guid isPermaLink="false">https://www.weirddatascience.net/?p=10231</guid>

					<description><![CDATA[<div class="mh-excerpt">Unidentifiable aerial and marine phenomena. Impossible lights in the sky. Patterns of visitation and terror. Insidious influences from the hadal voids between the stars. Who--what--swoop and glide through the ink-black nights of our world, probing and testing our structures, our societies, our minds? From barely remembered history, to early reports of impossible objects, to blurrily evidenced documentation, data concerning flying arcane observations has grown and twisted, along with our capacity to lay them bare, to subject them to analysis, and to interrogate their secrets.

In this year's OII Halloween Lecture, we will tremblingly revisit a Bayesian analysis of seventy years of UFO sightings, drawn from a dataset collected by the National UFO Reporting Center (NUFORC). Scepticism, fear, doubt, and most accepted standards of statistical rigor, will be cast aside in our unyielding and disquieting pursuit of an uncompromised truth.</div> <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2025/11/15/bayes-vs-the-invaders-redivivus/" title="Bayes vs. the Invaders (Redivivus)">[...]</a>]]></description>
										<content:encoded><![CDATA[<p>Straying still further from whatever dubious graces it once presumed, academia&#8217;s luciferous descent into murky realms of huddled speculation continues unabated. Relocated, reconstituted, in ever-fading cycles, the Oxford Internet Institute at the University of Oxford once again saw fit to deprive its students of the peace and comfort of banal rationality through this fourth annual Halloween Lecture.</p>
<p>In the absence of fresh insight, this year&#8217;s lecture revisits the chilling implications of humanity&#8217;s contact with inexplicable aerial and marine phenomena, drawing from the faintest whispers of the ante-historical record through to the shimmering echoes of statistical reasoning. Through what means do visitors from beyond the void encroach on our night-time skies? What subtle deceptions underpin their visible geometries? What values lie behind their peculiar interests in certain uncomfortably-favoured regions?</p>
<p>Despite all safeguards, and in the face of numerous barely-perceptible currents opposing such efforts, this event was captured, stored, and released into a world still cruelly unprepared to face its findings.</p>
<p>More details, and the underlying code, for these findings can be found&#8211;for those unwary enough to look&#8211;in the series of entries beginning <a href="https://www.weirddatascience.net/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/">here</a>.</p>
<p><a href="https://www.youtube.com/watch?v=WobPKY4UZc0"><img decoding="async" src="https://img.youtube.com/vi/WobPKY4UZc0/2.jpg" alt="Bayes vs. the Invaders (Redivivus)"></a></p>
<p><a href="https://www.youtube.com/watch?v=WobPKY4UZc0">Click here to view the video on YouTube</a>.</p>

<blockquote><p>
<strong>Oxford Internet Institute Halloween Lecture</strong><br />
Bayes vs. the Invaders (Redivivus): A Bayesian Analysis of 70 Years of UFO Sightings<br />
<em>Prof. Joss Wright</em><br />
<em>Oxford. October 2025</em></p>
<p>The searing heat of summer retreats, cools, fades, surrendering its vitality to the flickering uncertainties of autumn. Nights draw close, like dimly-remembered friends clustering in our dreams. The spring leaves abandon their verdant dance, as they age, wither, and drift into a russet swirl of skeletal, wind-stirred fragments. </p>
<p>The dying seasons return, dragging with them time-hallowed fears and uneasy rumours, pooling around these darkly dreaming spires in a mire of primal superstition. The agonizingly brittle certainties of the modern enlightenment, our desperate faith in the gossamer fabrics of scientific progress, falter in the face of primal terrors that lurk implacably in the gloom.</p>
<p>In these darkening days, as faith in our treasured understanding dims, it is yet again time to turn our faces fully to the darkness. Halloween, slouching inexorably towards our minds, impels us as scholars to gather our methods, our theories, our data, our knowledge; and glean what light we can from the primordial glimmers of the unknown.</p>
<p>Unidentifiable aerial and marine phenomena. Impossible lights in the sky. Patterns of visitation and terror. Insidious influences from the hadal voids between the stars. Who&#8211;what&#8211;swoop and glide through the ink-black nights of our world, probing and testing our structures, our societies, our minds? From barely remembered history, to early reports of impossible objects, to blurrily evidenced documentation, data concerning flying arcane observations has grown and twisted, along with our capacity to lay them bare, to subject them to analysis, and to interrogate their secrets.</p>
<p>In this year&#8217;s OII Halloween Lecture, we will tremblingly revisit a Bayesian analysis of seventy years of UFO sightings, drawn from a dataset collected by the National UFO Reporting Center (NUFORC). Scepticism, fear, doubt, and most accepted standards of statistical rigour, will be cast aside in our unyielding and disquieting pursuit of an uncompromised truth.
</p></blockquote>
<a href="https://www.weirddatascience.net/wp-content/uploads/2025/11/2025-bayes_vs_invaders-redivivus.pdf" class="pdfemb-viewer" style="" data-width="max" data-height="max" data-mobile-width="500"  data-scrollbar="none" data-download="on" data-tracking="on" data-newwindow="on" data-pagetextbox="off" data-scrolltotop="off" data-startzoom="100" data-startfpzoom="100" data-toolbar="bottom" data-toolbar-fixed="off">2025-bayes_vs_invaders-redivivus<br/></a>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2025/11/15/bayes-vs-the-invaders-redivivus/feed/</wfw:commentRss>
			<slash:comments>0</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">10231</post-id>	</item>
		<item>
		<title>Numbers of the Beast: Sasquatch Distribution Modelling</title>
		<link>https://www.weirddatascience.net/2025/07/21/numbers-of-the-beast-sasquatch-distribution-modelling/</link>
					<comments>https://www.weirddatascience.net/2025/07/21/numbers-of-the-beast-sasquatch-distribution-modelling/#respond</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Mon, 21 Jul 2025 18:09:01 +0000</pubDate>
				<category><![CDATA[cryptozoology]]></category>
		<category><![CDATA[event]]></category>
		<category><![CDATA[maps]]></category>
		<category><![CDATA[spatial analysis]]></category>
		<category><![CDATA[stan]]></category>
		<guid isPermaLink="false">https://www.weirddatascience.net/?p=9482</guid>

					<description><![CDATA[<div class="mh-excerpt">The third OII Halloween Lecture sinks bodily into the tortured mass of data concerning cryptozoological sightings in North America. Drawing on over a century of shadow-haunted sightings documenting the curiously repellant presence of the North America Sasquatch, or Bigfoot, we aim to identify the factors associated with its presence, delineate the confounding presence of other dread manifestations, and cast our minds globally for a faded glimpse of its remote and scarcely-conceived brethren.</div> <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2025/07/21/numbers-of-the-beast-sasquatch-distribution-modelling/" title="Numbers of the Beast: Sasquatch Distribution Modelling">[...]</a>]]></description>
										<content:encoded><![CDATA[<p>Dredged from the stygian depths of last year&#8217;s waning: a cruelly belated artefact of academia&#8217;s primordial descent. For a third time, the Oxford Internet Institute at the University of Oxford—scarcely willing, but falteringly unable to reflect on its own ill-fated decisions—chose to risk the sanity and statistical intuition of its students against the numerically unstable nightmares writhing beneath the tattered fabric of our waking world.</p>
<p>This third OII Halloween Lecture sinks bodily into the tortured mass of data concerning cryptozoological sightings in North America. Drawing on over a century of shadow-haunted sightings documenting the curiously repellant presence of the North America Sasquatch, or Bigfoot, we aim to identify the factors associated with its presence, delineate the confounding presence of other dread manifestations, and cast our minds globally for a faded glimpse of its remote and scarcely-conceived brethren.</p>
<p>In what can only generously be considered an act of gross negligence, this lecture was stored, at great risk to both its author and its audience, digitally. Technology has, once again, brought us closer than we might care to dread to secrets that we were never intended to taste.</p>
<p>A sharper, more visceral presentation of the baroque thinking underpinning these materials will follow, in an ever-spiralling series of posts on this site. Until then, however, incautious travellers may solemnly consider the below.</p>

<div class="youtube-embed ye-container" itemprop="video" itemscope itemtype="https://schema.org/VideoObject">
	<meta itemprop="url" content="https://www.youtube.com/v/M_upySOOzcI" />
	<meta itemprop="name" content="Numbers of the Beast: Sasquatch Distribution Modelling" />
	<meta itemprop="description" content="Numbers of the Beast: Sasquatch Distribution Modelling" />
	<meta itemprop="uploadDate" content="2025-07-21T19:09:01+01:00" />
	<meta itemprop="thumbnailUrl" content="https://i.ytimg.com/vi/M_upySOOzcI/default.jpg" />
	<meta itemprop="embedUrl" content="https://www.youtube.com/embed/M_upySOOzcI" />
	<meta itemprop="height" content="340" />
	<meta itemprop="width" content="560" />
	<iframe style="border: 0;" class="youtube-player" width="560" height="340" src="https://www.youtube.com/embed/M_upySOOzcI" allowfullscreen></iframe>
</div>

<blockquote><p>
<strong>OII Halloween Lecture</strong><br />
Sasquatch Distribution Modelling: Investigating patterns of Bigfoot sightings in North America.<br />
<em>Prof. Joss Wright</em><br />
<em>Oxford. October 2024</em></p>
<p>The nights grow ever closer. Streetlights flicker, shrouded in the mists, striving to pierce the gloom. The warm certainties of summer give way to the cold, dark ambiguities of autumn. Rumour, myth, and legend rise, primeval, from the shadowed recesses of our collective consciousness, undermining our faith in the fragile congruities that structure our lives.</p>
<p>As summer surrenders to the inexorable tread of autumn, our resolve falters against the unknown horrors residing in the tenebrous peripheries of the world. As scientists, as scholars, our duty is to cling resolutely to our methods and our ideals in the face of encroaching darkness. Our tools may seem fragile in the face of the seething irrationality of the night, but we are called to peer, however tremulously, wherever our inquiries may lead us.</p>
<p>Lights streak across the sky. Stories are woven of twisted faces in the darkness, half-glimpsed creatures in ancient forests, strange encounters in the wilderness. From the earliest stirrings of humanity, to the patterns of complex arcana that silently control our lives today, folklore and legend have long reported phenomena that rebel against mundane description or understanding. As our technologies evolve, and our ability to collate, scrutinise, and manipulate data spiral beyond all restraint, we are ever more capable, if not indeed obliged, to bring the lens of science to bear on these harrowing mysteries.</p>
<p>To embrace this dark season, you are invited to the annual Oxford Internet Institute Halloween Lecture.</p>
<p>This year we will pursue one of the world’s most notorious cryptozoological phenomena, investigating over a century of data regarding sightings of the Sasquatch, or Bigfoot, of North America. In which regions are these cryptic precursors of humanity most commonly observed? What factors, whether environmental or physical, create habitats most suitable for the Sasquatch to thrive, hidden from the encroaching pressures of humanity? Where, were we bold enough to look, might we seek other populations of these elusive creatures?</p>
<p>In this lecture we will examine some of the history surrounding sightings of Bigfoot, and related cryptids. We will impetuously apply statistical methods to derive underlying patterns from reported sightings, and heedlessly strive to uncover their meaning and implications. What can we learn from the accumulated data about the habits of cryptic species living on the fringes of our world? Is the beast, as ever, closer to us than we wish to believe?</p></blockquote>
<a href="https://www.weirddatascience.net/wp-content/uploads/2025/07/sasquatch_distribution_modelling.pdf" class="pdfemb-viewer" style="" data-width="max" data-height="max" data-mobile-width="500"  data-scrollbar="none" data-download="on" data-tracking="on" data-newwindow="on" data-pagetextbox="off" data-scrolltotop="off" data-startzoom="100" data-startfpzoom="100" data-toolbar="bottom" data-toolbar-fixed="off">sasquatch_distribution_modelling<br/></a>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2025/07/21/numbers-of-the-beast-sasquatch-distribution-modelling/feed/</wfw:commentRss>
			<slash:comments>0</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">9482</post-id>	</item>
		<item>
		<title>Readings from the Book</title>
		<link>https://www.weirddatascience.net/2024/01/28/readings-from-the-book/</link>
					<comments>https://www.weirddatascience.net/2024/01/28/readings-from-the-book/#respond</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Sun, 28 Jan 2024 16:27:02 +0000</pubDate>
				<category><![CDATA[beyond the veil]]></category>
		<category><![CDATA[bibliophilia]]></category>
		<category><![CDATA[event]]></category>
		<category><![CDATA[linguistics]]></category>
		<category><![CDATA[stan]]></category>
		<guid isPermaLink="false">https://www.weirddatascience.net/?p=5768</guid>

					<description><![CDATA[<div class="mh-excerpt">Once again, the Oxford Internet Institute at the University of Oxford -- through madness, or through omission brought on by horrified incredulity -- saw fit to expose its students to the nightmarish patterns that descend, fractal-like, endlessly below the surface of mundane reality. This second OII Halloween Lecture drew on the twisted meanderings we travellers have taken through the cryptic verbiage of the Voynich Manuscript.</div> <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2024/01/28/readings-from-the-book/" title="Readings from the Book">[...]</a>]]></description>
										<content:encoded><![CDATA[<p>Once again, the Oxford Internet Institute at the University of Oxford &#8212; through madness, or through omission brought on by horrified incredulity &#8212; saw fit to expose its students to the nightmarish patterns that descend, fractal-like, endlessly below the surface of mundane reality.</p>
<p>This second OII Halloween Lecture drew on the twisted meanderings we travellers have taken through the cryptic verbiage of the Voynich Manuscript. We aim to establish the dread authenticity of the text, by rousing its very statistical bones from the inscrutable fasciae of its pages. Walking a tightrope between careful statistical exploration and ever-burgeoning insanity, we further explore the structures that arise from the text, separating the untranslated knowledge in the book into coherent bodies for future study.</p>
<p>In yet another, almost criminially negligent, oversight, the OII&#8217;s 2024 Halloween Lecture was captured, frozen in space and time, for the detriment and despair of the unexpectant world.</p>

<div class="youtube-embed ye-container" itemprop="video" itemscope itemtype="https://schema.org/VideoObject">
	<meta itemprop="url" content="https://www.youtube.com/v/nl7QRWIRcSk" />
	<meta itemprop="name" content="Readings from the Book" />
	<meta itemprop="description" content="Readings from the Book" />
	<meta itemprop="uploadDate" content="2024-01-28T16:27:02+00:00" />
	<meta itemprop="thumbnailUrl" content="https://i.ytimg.com/vi/nl7QRWIRcSk/default.jpg" />
	<meta itemprop="embedUrl" content="https://www.youtube.com/embed/nl7QRWIRcSk" />
	<meta itemprop="height" content="340" />
	<meta itemprop="width" content="560" />
	<iframe style="border: 0;" class="youtube-player" width="560" height="340" src="https://www.youtube.com/embed/nl7QRWIRcSk" allowfullscreen></iframe>
</div>

<p>&nbsp;</p>
<p>For those not driven to blissful negation by the tortured ramblings of the above, the underlying materials for the talk are presented, with neither hope nor tremor, here.</p>
<a href="https://www.weirddatascience.net/wp-content/uploads/2024/01/illuminating_the_illuminated.pdf" class="pdfemb-viewer" style="" data-width="max" data-height="max" data-mobile-width="500"  data-scrollbar="none" data-download="on" data-tracking="on" data-newwindow="on" data-pagetextbox="off" data-scrolltotop="off" data-startzoom="100" data-startfpzoom="100" data-toolbar="bottom" data-toolbar-fixed="off">illuminating_the_illuminated<br/></a>
<p>&nbsp;</p>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2024/01/28/readings-from-the-book/feed/</wfw:commentRss>
			<slash:comments>0</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">5768</post-id>	</item>
		<item>
		<title>Whisperings in the Academy</title>
		<link>https://www.weirddatascience.net/2022/11/20/whisperings-in-the-academy/</link>
					<comments>https://www.weirddatascience.net/2022/11/20/whisperings-in-the-academy/#respond</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Sun, 20 Nov 2022 13:12:43 +0000</pubDate>
				<category><![CDATA[event]]></category>
		<category><![CDATA[maps]]></category>
		<category><![CDATA[spatial analysis]]></category>
		<category><![CDATA[stan]]></category>
		<category><![CDATA[ufo]]></category>
		<guid isPermaLink="false">https://www.weirddatascience.net/?p=4385</guid>

					<description><![CDATA[<div class="mh-excerpt">The noblest of human endeavours is to enlighten the uninitiated consciousness; to bare its awareness before the endless and terrifying vistas that lie beyond darkness and ignorance.</div> <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2022/11/20/whisperings-in-the-academy/" title="Whisperings in the Academy">[...]</a>]]></description>
										<content:encoded><![CDATA[<p>The noblest of human endeavours is to enlighten the uninitiated consciousness; to bare its awareness before the endless and terrifying vistas that lie beyond darkness and ignorance.</p>
<p>In pursuit of such necessarily painful revelations the Oxford Internet Insitute at the University of Oxford &#8212; the unwitting host on which the investigations here parasitise &#8212; recently hosted an inaugural Halloween lecture. This oration drew on several years of dark explorations chronicled in this blog, to inculcuate into a new generation of unprepared and curious minds the horror and necessity of subjecting our reality to the insidious power of statistical science. Through what seems a dangerously careless oversight, this brief glimpse of truth was recorded and made available for posterity.</p>

<div class="youtube-embed ye-container" itemprop="video" itemscope itemtype="https://schema.org/VideoObject">
	<meta itemprop="url" content="https://www.youtube.com/v/qaBYjnXbnWE" />
	<meta itemprop="name" content="Whisperings in the Academy" />
	<meta itemprop="description" content="Whisperings in the Academy" />
	<meta itemprop="uploadDate" content="2022-11-20T13:12:43+00:00" />
	<meta itemprop="thumbnailUrl" content="https://i.ytimg.com/vi/qaBYjnXbnWE/default.jpg" />
	<meta itemprop="embedUrl" content="https://www.youtube.com/embed/qaBYjnXbnWE" />
	<meta itemprop="height" content="340" />
	<meta itemprop="width" content="560" />
	<iframe style="border: 0;" class="youtube-player" width="560" height="340" src="https://www.youtube.com/embed/qaBYjnXbnWE" allowfullscreen></iframe>
</div>

<p>&nbsp;</p>
<p>For the terminally inquisitive, the archival materials on which this work was drawn are presented here.</p>
<a href="https://www.weirddatascience.net/wp-content/uploads/2022/11/bayes_vs_invaders.pdf" class="pdfemb-viewer" style="" data-width="max" data-height="max" data-mobile-width="500"  data-scrollbar="none" data-download="on" data-tracking="on" data-newwindow="on" data-pagetextbox="off" data-scrolltotop="off" data-startzoom="100" data-startfpzoom="100" data-toolbar="bottom" data-toolbar-fixed="off">bayes_vs_invaders<br/></a>
<p>&nbsp;</p>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2022/11/20/whisperings-in-the-academy/feed/</wfw:commentRss>
			<slash:comments>0</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">4385</post-id>	</item>
		<item>
		<title>Illuminating the Illuminated – Part Four: Tempora Mutantur &#124; Changepoint Analysis of the Voynich Manuscript</title>
		<link>https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/</link>
					<comments>https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/#comments</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Fri, 21 Feb 2020 10:31:38 +0000</pubDate>
				<category><![CDATA[bibliophilia]]></category>
		<category><![CDATA[cryptology]]></category>
		<category><![CDATA[stan]]></category>
		<guid isPermaLink="false">https://www.weirddatascience.net/?p=2009</guid>

					<description><![CDATA[<div class="mh-excerpt">Our past interrogation of the Voynich Manuscript has deconstructed its esoteric symbols into a form more suitable for our ends, subjected its statistical properties to comparison with more mundane texts, and unearthed its hidden internal structures via the esoteric process of topic modelling. In this final post, we <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/" title="Illuminating the Illuminated – Part Four: Tempora Mutantur &#124; Changepoint Analysis of the Voynich Manuscript">[...]</a></div>]]></description>
										<content:encoded><![CDATA[<p>Our past interrogation of the Voynich Manuscript has <a href="https://www.weirddatascience.net/2019/09/26/illuminating-the-illuminated-a-first-look-at-the-voynich-manuscript/">deconstructed its esoteric symbols into a form more suitable for our ends</a>, <a href="https://www.weirddatascience.net/2019/10/28/illuminating-the-illuminated-part-two-ipsa-scientia-potestas-est/">subjected its statistical properties to comparison with more mundane texts</a>, and <a href="https://www.weirddatascience.net/2019/12/24/illuminating-the-illuminated-part-three-topics-of-invention-topic-modelling-the-voynich-manuscript/">unearthed its hidden internal structures via the esoteric process of topic modelling</a>. In this final post, we will build on the structures revealed in earlier posts to ask how, if at all, the Voynich Manuscript&#8217;s textual properties <em>shift</em> within the text itself. Are there significant discontinuities in the writing, indicating a separation of the manuscript into meaningful sections? Or is the text merely a homogenous mass more suggestive of a rote, mechanical, generative procedure?</p>
<p>To address this question we will delve once more into the arcana of machine learning, and draw out the technique of <em>changepoint analysis</em>. This procedure aims to identify one or more points in a series of observations at which the underlying process that generates the data has somehow altered.</p>
<p>Once more, we will operate within the warm embrace of Bayesian statistics and exploit the <a href="https://mc-stan.org/">Stan modelling language</a> as our means to cast light into the darkness<span id='easy-footnote-1-2009' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/#easy-footnote-bottom-1-2009' title='As of this post, future work will be accompanied with public code and data available at &lt;a href=&quot;https://github.com/weirddatascience/weirddatascience&quot;&gt;https://github.com/weirddatascience/weirddatascience&lt;/a&gt;. As numerous of our routines, particularly for plot generation, are repeated, future code will also rely on our custom R package: &lt;a href=&quot;https://github.com/weirddatascience/grimoire&quot;&gt;&lt;code&gt;grimoire&lt;/code&gt;&lt;/a&gt;. We will also be dredging through our dark history to make the code for previous posts public in the near future.'><sup>1</sup></a></span>.</p>
<h2>On Shifting Sands</h2>
<p>Changepoint analysis is an active field of endeavour, with deep subtleties in its application. For the purposes of this analysis we will focus on the comparatively simple problem of identifying a single changepoint amongst the teeming mass of the Voynich Manuscript&#8217;s strangely compelling glyphs.</p>
<p>Statistical analysis of changepoints has been applied to a number of historical texts. To provide a first, tantalising glimpse into a world characterised by authorship analysis and the dark arts of <a href="https://www1.icsi.berkeley.edu/~sadia/papers/adversarial_stylometry.pdf">adversarial stylometry</a>, we begin by reproducing the work of <a href="https://www.tandfonline.com/doi/abs/10.1080/0266476052000330295">Riba and Ginebra</a> in ascertaining the existence of a shift in authorship in the 15th century Catalan chivalric romance <a href="http://www.gutenberg.org/ebooks/378">Tirant lo Blanc</a>.</p>
<p>Briefly, Tirant lo Blanc was written by <a href="https://en.wikipedia.org/wiki/Joanot_Martorell">Joanot Martorel</a>, a Valencian knight, whose untimely death left the manuscript unfinished. The work was completed and published by <a href="https://en.wikipedia.org/wiki/Mart%C3%AD_Joan_de_Galba">Martí Joan de Galba</a>. The specific nature of his contributions have, however, been the subject of some debate: did he substantially compose parts of the text, or simply arrange and edit the work?</p>
<p>Riba and Ginebra proposed, in 2005, to identify any stylistic change in the work through a Bayesian analysis of the frequency of word lengths in the document. Their approach, built on a tradition of such analyses in the stylometry literature, relies on the fact that differing authors, even when attempting to mimic the style of another, unconsciously make different word choices. Most importantly, the relative frequency of shorter <em>context free</em> words is likely to differ between authors.</p>
<p>From a certain analytical perspective, each word in a sequence of text can be represented merely by its length, as in the analyses of our <a href="https://www.weirddatascience.net/2019/10/28/illuminating-the-illuminated-part-two-ipsa-scientia-potestas-est/">earlier posts</a>. Taking this view to a probabilistic extreme, a text, therefore, can be considered as a sequence of draws from a <a href="https://en.wikipedia.org/wiki/Categorical_distribution"><em>categorical distribution</em></a> of word lengths. We may consider the length of each word as resulting from rolls of some abstract, biased die with a number of sides equal to the number of possible word lengths in the prose. The full text, therefore, is itself a <a href="https://en.wikipedia.org/wiki/Multinomial_distribution"><em>multinomial distribution</em></a> in which the number of categories matches the possible lengths of words observed in the document, and the number of trials is the number of words in the text. The stylistic differences between authors, therefore, is known to be revealed most strongly in the relative frequency of the shorter words.</p>
<p>Having descended thus far, and with dark suspicions of an authorship change disrupting the contiguity of Martorel&#8217;s opus, we hypothesise that the entire volume may best be described by not one, but by two multinomial distributions over short word lengths: one for the earlier text of the original author, with a second describing the later contributions of his posthumous collaborator. The point of division between these distributions is the changepoint.</p>
<h2>Winds of Change</h2>
<p>To drag this concept from its abstract formulation to a tangible realisation, we turn to the Stan probabilistic programming language, The models here draw heavily on the <a href="https://mc-stan.org/docs/2_22/stan-users-guide/index.html">Stan user&#8217;s guide</a> <a href="https://mc-stan.org/docs/2_22/stan-users-guide/change-point-section.html">changepoint section</a>, which lays out the concepts underlying these approaches with horrifying clarity.</p>
<p>Perhaps the most unusual aspect of implementing this model is due to Stan&#8217;s inability to sample <em>discrete</em> parameters; in this case the location of the changepoint. As such the model must conceal a <em>latent</em> discrete parameter cunningly hidden in its construction. This may then be marginalised out to reveal the probability of each value of the latent parameter. The model we construct here, therefore, will provide us not simply with a <em>point estimate</em> of the most likely changepoint, but a set of probabilities for each possible changepoint.</p>

<p>As cryptically hinted above, our model of the Voynich text abstracts its prose to counts of word lengths found on each folio of the manuscript, resulting in a multinomial distribution of word lengths. For the changepoint, we hypothesise that there are not one, but two multinomials with different parameters falling on either side of some changepoint. Our goal is to identify the pivotal folio at which this underlying shift most likely occurs.</p>
<p>Representing this more formally, in the style used for generative Bayesian models, we can write the distribution of word lengths, &#92;(\Omega&#92;), in terms of its hyperparameters as:</p>
<p>$$\begin{eqnarray}&#92;<br />
\Omega &amp;\sim&amp; \mathbf{Multinomial}( t &lt; c~?~\theta_e : \theta_l )&#92;&#92;<br />
\theta_e &amp;\sim&amp; \mathbf{Dirichlet}(\alpha)&#92;&#92;<br />
\theta_l &amp;\sim&amp; \mathbf{Dirichlet}(\alpha)&#92;&#92;<br />
c &amp;\sim&amp; \mathbf{Uniform}(0, 1)<br />
\end{eqnarray}$$</p>
<p>The most crucial element for isolating the changepoint is the <a href="https://mc-stan.org/docs/2_18/reference-manual/conditional-operator-section.html">conditional operator </a> in the first line. We treat the frequency of words of different lengths on a given folio as one point in a sequence, indexed by the value &#92;(t&#92;). The conditional statement encodes that observed word lengths prior to some unknown point &#92;(t = c&#92;) are drawn from a multinomial with one vector of parameters, &#92;(\theta_e&#92;); from that folio onwards, word lengths are drawn according to a second multinomial with parameter vector &#92;(\theta_l&#92;). When appropriately constructed, fitting the model produces a posterior distribution across the various possible &#92;(\theta_e&#92;) and &#92;(\theta_l&#92;) parameters for all possible changepoints. The folio at which the posterior probability of &#92;(c&#92;) is highest is our best estimate of the changepoint, and is accompanied by estimates of &#92;(\theta_e&#92;) and &#92;(\theta_l&#92;) around that changepoint.</p>
<p>As mentioned above, we <em>marginalise</em> the discrete changepoint parameter, &#92;(c&#92;), rather than sampling it directly. A full example of the concept, applied to a Poisson distribution, is given by the Stan Users&#8217; Guide <a href="https://mc-stan.org/docs/2_22/stan-users-guide/change-point-section.html">changepoint section</a>. This key step moves the parameter &#92;(c&#92;) from the full joint probability function of the model, resulting in a likelihood of word lengths according to the parameters &#92;(\theta_e&#92;) and &#92;(\theta_l&#92;), which can be calculated in Stan by summing over this likelihood for all possible values of &#92;(c&#92;)<span id='easy-footnote-2-2009' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/#easy-footnote-bottom-2-2009' title='The marginalisation here is given as a sum, rather than a product, due to Stan operating on the log scale for reasons of computational efficiency and numerical stability.'><sup>2</sup></a></span>.</p>
<p>Reproducing, with only slight adaptations, the original Poisson example, our full joint probability would be:</p>
<p>$$p(\theta_e, \theta_l, c, \Omega) =<br />
p(\theta_e)p(\theta_l)p(c)p(\Omega|\theta_e,\theta_l,c)$$</p>
<p>Marginalising out &#92;(c&#92;), this can be represented as:</p>
<p>$$\begin{eqnarray}<br />
p(\Omega|\theta_e, \theta_l) &amp;=&amp; \sum_{c=1}^Tp(c,\Omega|c,\theta_e,\theta_l)&#92;&#92;<br />
&amp;=&amp; \sum_{c=1}^Tp(c)p(\Omega|c,\theta_e,\theta_l)<br />
\end{eqnarray}$$</p>
<p>The result is that our Stan model can be constructed by sampling across values of &#92;(\theta_e&#92;) and &#92;(\theta_l&#92;) for all possible values of &#92;(c&#92;). Due to the requirement to sum across all possible values of the discrete paramete, however, this subterfuge of marginalisation is restricted in general to <em>bounded</em> discrete parameters.</p>
<p>We can distill the above into a Stan model as given below.</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Multinomial changepoint model</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>multinomial_changepoint.stan</code><br />
[code language=&#8221;c&#8221;]
<p>data {</p>
<p>	int&lt;lower=0&gt; num_obs;				// Number of observations (rows/pages) in data.<br />
	int&lt;lower=0&gt; num_cats;				// Number of categories in data.<br />
	int y[num_obs, num_cats];  			// Matrix of observations.</p>
<p>	vector&lt;lower=0&gt;[num_cats] alpha;		// Dirichlet prior values.</p>
<p>}</p>
<p>transformed data {</p>
<p>	// Uniform prior across all time points for changepoint.<br />
	real log_unif;<br />
	log_unif = -log(num_obs);</p>
<p>}</p>
<p>parameters {</p>
<p>	// Two sets of parameters.<br />
	// One (early) before changepoint, one (late) for after.<br />
	simplex[num_cats] theta_e;<br />
	simplex[num_cats] theta_l;</p>
<p>}</p>
<p>transformed parameters {</p>
<p>	//	// This code shows a slower, but easier to understand updating of log posterior via summation.<br />
	//  vector[num_obs] lp;<br />
	//  lp = rep_vector(log_unif, num_obs);<br />
	//  for (s in 1:num_obs)<br />
	//    for (t in 1:num_obs)<br />
	//      lp[s] = lp[s] + multinomial_lpmf(y[t,] | t &lt; s ? theta_e : theta_l);</p>
<p>	// This approach relies on dynamic programming to reduce runtime from quadratic to linear in num_obs.<br />
	// See &lt;https://mc-stan.org/docs/2_19/stan-users-guide/change-point-section.html&gt;<br />
		vector[num_obs] log_p;<br />
	{<br />
		vector[num_obs + 1] log_p_e;<br />
		vector[num_obs + 1] log_p_l;</p>
<p>		log_p_e[1] = 0;<br />
		log_p_l[1] = 0;</p>
<p>		for( i in 1:num_obs ) {<br />
			log_p_e[i + 1] = log_p_e[i] + multinomial_lpmf(y[i,] | theta_e );<br />
			log_p_l[i + 1] = log_p_l[i] + multinomial_lpmf(y[i,] | theta_l );<br />
		}</p>
<p>		log_p =<br />
			rep_vector( -log(num_obs) + log_p_l[num_obs + 1], num_obs) +<br />
			head(log_p_e, num_obs) &#8211; head(log_p_l, num_obs);<br />
	}<br />
}</p>
<p>model {</p>
<p>	// Priors<br />
	theta_e ~ dirichlet( alpha );<br />
	theta_l ~ dirichlet( alpha );</p>
<p>	target += log_sum_exp( log_p );</p>
<p>}</p>
<p>generated quantities {</p>
<p>	simplex[num_obs] changepoint_simplex;	// Simplex of locations for changepoint.</p>
<p>	// Convert the log posterior to a simplex.<br />
	changepoint_simplex = softmax( log_p );</p>
<p>}</p>
[/code]
</div></div>
</div>
<p>To launch the model in gentler waters, we apply it to Martorel and de Galba&#8217;s <em>Tirant lo Blanc</em> to discover where, if at all, de Galba&#8217;s major contributions to the text begin, and see the extent to which our Stan rendering reproduces the results of Riba and Ginebra&#8217;s analysis. As in their work we will focus only on those words with length shorter than 5 letters, where the key <em>stylistic</em> difference between authors makes itself apparent.</p>
<p>We place a relative uninformative <a href="https://en.wikipedia.org/wiki/Dirichlet_distribution">Dirichlet prior</a> on the multinomial &#92;(\theta_e&#92;) and &#92;(\theta_l&#92;) parameters, with the vector of &#92;(\alpha&#92;) values set to one. This results in a uniform distribution across all possible simplexes. Note that this does <em>not</em> push the multinomial towards a uniform simplex, but instead that all possible simplexes are equally likely. &#92;(\alpha \ge 1&#92;) produces increasingly uniform simplexes; &#92;(0 \le \alpha \le 1&#92;) produces simplexes in which the probability mass is more likely to be concentrated in some given element.</p>
<p>With the resulting data and model in unison, we can see the results of this analytic process.</p>
<figure id="attachment_2035" aria-describedby="caption-attachment-2035" style="width: 1920px" class="wp-caption aligncenter"><a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot.png"><img loading="lazy" decoding="async" data-attachment-id="2035" data-permalink="https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/multinomial_changepoint_tirant_plot-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="multinomial_changepoint_tirant_plot.png" data-image-description="&lt;p&gt;Tirant lo Blanc Changepoint&lt;/p&gt;
" data-image-caption="&lt;p&gt;Tirant lo Blanc Changepoint&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot-1024x576.png" src="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot.png" alt="Tirant lo Blanc Changepoint" width="1920" height="1080" class="size-full wp-image-2035" srcset="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot-1536x864.png 1536w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot-678x381.png 678w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-2035" class="wp-caption-text">Tirant lo Blanc Changepoint | (<a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_tirant_plot.pdf">PDF Version</a>)</figcaption></figure>
<p>Our multinomial automaton suggests a location for a significant stylistic changepoint in <em>Tirant lo Blanc</em> with the main concentration of probability mass around chapter 374. Perhaps unsurprisingly, but pleasingly, this is in close agreement with the earlier analysis of Riba and Ginebra, who placed their estimates between chapters 371 and 382.</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span><em>Tirant lo Blanc</em> analysis code</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code></code><br />
[code language=&#8221;r&#8221;]
<p>library( tidyverse )<br />
library( tidyselect )<br />
library( magrittr )</p>
<p>library( rstan )</p>
<p>library( tidytext )</p>
<p># Load Tirant data<br />
message( &quot;Reading raw Tirant data&#8230;&quot; )<br />
tirant_tbl &lt;-<br />
	read_csv( &quot;data/tirant_raw.csv&quot;, col_names=FALSE ) %&gt;%<br />
	rename( chapter = X1, text = X2 ) %&gt;%<br />
	mutate( page = as.numeric( rownames(.) ) )</p>
<p># Tokenize<br />
tirant_words &lt;-<br />
	tirant_tbl %&gt;%<br />
	unnest_tokens( word, text ) </p>
<p># Pivot the data wider to be presented to Stan as a matrix of multinomial samples.<br />
tirant_lengths &lt;-<br />
	tirant_words %&gt;%<br />
	mutate( word_length = str_length( word ) ) %&gt;%<br />
	mutate( word_length = ifelse( word_length &gt; 9, 10, word_length )) %&gt;%<br />
	group_by( page, word_length ) %&gt;%<br />
	summarise( count = n( )) %&gt;%<br />
	pivot_wider( names_from = word_length, values_from = count ) %&gt;%<br />
	ungroup %&gt;%<br />
	select( -c(page,&quot;5&quot;,&quot;6&quot;,&quot;7&quot;,&quot;8&quot;,&quot;9&quot;,&quot;10&quot;) ) %&gt;%<br />
	select(sort(peek_vars())) %&gt;%<br />
	replace( is.na(.), 0 )</p>
<p>if( not( file.exists( &quot;work/multinomial_changepoint_tirant_fit.rds&quot; ) ) ) {</p>
<p>	message( &quot;Fitting multinomial model.&quot;)<br />
	tirant_multinom_fit &lt;-<br />
		stan( &quot;multinomial_changepoint.stan&quot;,<br />
			  data=list(<br />
							num_obs=487,<br />
							num_cats=4,<br />
							y = as.matrix( tirant_lengths ),<br />
							alpha = rep( 1, 4 ) ),<br />
			  iter=16000,<br />
				control=list(<br />
							adapt_delta=0.98,<br />
							max_treedepth=15 ) )</p>
<p>	saveRDS( tirant_multinom_fit, &quot;work/multinomial_changepoint_tirant_fit.rds&quot; )</p>
<p>} else {<br />
	message( &quot;Loading saved multinomial model.&quot;)<br />
	tirant_multinom_fit &lt;- readRDS( &quot;work/multinomial_changepoint_tirant_fit.rds&quot; )<br />
}</p>
<p># Plot the calculated changepoint probabilities.<br />
# (&#8216;changepoint_simplex&#8217;).<br />
mean_changepoint_prob &lt;-<br />
	extract( tirant_multinom_fit )$changepoint_simplex %&gt;%<br />
	as_tibble( .name_repair=&quot;unique&quot; ) %&gt;%<br />
	summarise_all( mean ) %&gt;%<br />
	pivot_longer( everything() ) %&gt;%<br />
	rowid_to_column() </p>
<p># Save values for plotting<br />
saveRDS( mean_changepoint_prob, file=&quot;work/mean_changepoint_prob_tirant.rds&quot; )</p>
[/code]
</div></div>
</div>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span><em>Tirant lo Blanc</em> data file</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/tirant_raw.csv"><em>Tirant lo Blanc</em> formatted raw text data.</a><br />
</div></div>
</div>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span><em>Tirant lo Blanc</em> changepoint plot code</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>multinomial_changepoint_tirant_plot.r</code><br />
[code language=&#8221;r&#8221;]
<p>library( tidyverse )<br />
library( magrittr )</p>
<p>library( ggthemes )<br />
library( showtext )</p>
<p>library( grimoire ) # &lt;https://github.com/weirddatascience/grimoire&gt;</p>
<p># Fonts<br />
font_add( &quot;main_font&quot;, &quot;resources/fonts/alchemy/1651 Alchemy/1651AlchemyNormal.otf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;resources/fonts/alchemy/1651 Alchemy/1651AlchemyNormal.otf&quot;)</p>
<p>showtext_auto()</p>
<p>mean_changepoint_prob &lt;-<br />
	readRDS( &quot;work/mean_changepoint_prob_tirant.rds&quot; )</p>
<p>changepoint_plot &lt;-<br />
	ggplot( mean_changepoint_prob ) +<br />
	geom_col( aes( x=rowid, y=value ), fill=weird_colours[&quot;blood&quot;] ) +<br />
	labs( x=&quot;Chapter&quot;, y=&quot;Probability of Changepoint&quot; ) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;transparent&quot;, colour = &quot;transparent&quot;),<br />
			plot.background = element_rect(fill = &quot;transparent&quot;, colour = &quot;transparent&quot;),<br />
			plot.title = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=22 ),<br />
			plot.subtitle = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.text = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.title.x = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.title.y = element_text( family=&quot;bold_font&quot;, angle=90, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.line = element_line( colour=weird_colours[&quot;ink&quot;] ),<br />
			panel.grid.major.x = element_blank(),<br />
			panel.grid.major.y = element_blank(),<br />
			panel.grid.minor.x = element_blank(),<br />
			panel.grid.minor.y = element_blank()<br />
			) </p>
<p># grimoire::decorate_plot() from &lt;https://github.com/weirddatascience/grimoire&gt;<br />
parchment_plot &lt;-<br />
	decorate_plot(<br />
					  title=&quot;Tirant lo Blanc Chapter Changepoint Probability&quot;,<br />
					  subtitle=&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;,<br />
					  plot=changepoint_plot,<br />
					  bg_image=&quot;resources/img/parchment.jpg&quot;,<br />
					  footer=&quot;Data: http://einesdellengua.com/tirantloweb/tirantloblanch.html&quot; )</p>
<p>save_plot(&quot;output/multinomial_changepoint_tirant_plot.pdf&quot;,<br />
							parchment_plot,<br />
							base_width = 16,<br />
							base_height = 9,<br />
			           	base_aspect_ratio = 1.78 )</p>
[/code]
</div></div>
</div>
<h2>Nos et mutamur in illis</h2>
<p>The changepoint model realises the dark imaginings of our predecessors. What horrors might it reveal when applied to the Voynich Manuscript? Following the logic of the above analysis, we will focus initially on the shorter words in the Voynich corpus.</p>
<p>To improve model fit we will place a little more information in the prior, setting the &#92;(\alpha&#92;) values for the Dirichlet prior to 0.6 to push the multinomial towards more concentrated probabilities. This reflects the gamma distribution of word length frequencies discussed in our <a href="https://www.weirddatascience.net/2019/10/28/illuminating-the-illuminated-part-two-ipsa-scientia-potestas-est/">earlier analysis</a>. We also combine all single- and two-letter Voynich terms into a single category due to the small number of words falling into these categories<span id='easy-footnote-3-2009' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/#easy-footnote-bottom-3-2009' title='This second piece of wisdom, in particular, was provided, along with a host of other points of guidance, via the &lt;a href=&quot;https://discourse.mc-stan.org/&quot;&gt;Stan Forums&lt;/a&gt;. Particular thanks are due to forum members @bbales and @emiruz.'><sup>3</sup></a></span>.</p>
<p>The model can now reveal where, if at all, a likely fracture resides in the textual assemblage of the Voynich Manuscript.</p>
<figure id="attachment_2052" aria-describedby="caption-attachment-2052" style="width: 1920px" class="wp-caption aligncenter"><a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot.png"><img loading="lazy" decoding="async" data-attachment-id="2052" data-permalink="https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/multinomial_changepoint_voynich_plot-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="multinomial_changepoint_voynich_plot" data-image-description="&lt;p&gt;Voynich Manuscript changepoint plot&lt;/p&gt;
" data-image-caption="&lt;p&gt;Voynich Manuscript changepoint plot&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot-1024x576.png" src="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot.png" alt="Voynich Manuscript Changepoint" width="1920" height="1080" class="size-full wp-image-2052" srcset="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot-1536x864.png 1536w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot-678x381.png 678w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-2052" class="wp-caption-text">Voynich Manuscript Changepoint | (<a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_plot.pdf">PDF Version</a>)</figcaption></figure>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Voynich Manuscript word length analysis code</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>multinomial_changepoint_voynich.r</code><br />
[code language=&#8221;r&#8221;]
<p>library( tidyverse )<br />
library( tidyselect )<br />
library( magrittr )</p>
<p>library( rstan )</p>
<p>library( tidytext )</p>
<p># Load Voynich data<br />
message( &quot;Reading raw Voynich data&#8230;&quot; )<br />
voynich_tbl &lt;-<br />
	read_csv( &quot;data/voynich_raw.csv&quot;, col_names=FALSE ) %&gt;%<br />
	rename( folio = X1, text = X2 )</p>
<p># Tokenize<br />
voynich_words &lt;-<br />
	voynich_tbl %&gt;%<br />
	unnest_tokens( word, text ) </p>
<p># Calculate the lengths of words<br />
voynich_pure_lengths &lt;-<br />
	voynich_words %&gt;%<br />
	transmute( word_length = str_length( word ) ) </p>
<p>voynich_pure_lengths$count &lt;- 1</p>
<p># Pivot the data wider to be presented to Stan as a matrix of multinomial samples.<br />
voynich_lengths &lt;-<br />
	voynich_words %&gt;%<br />
	mutate( word_length = str_length( word ) ) %&gt;%<br />
	mutate( word_length = ifelse( word_length &gt; 8, 9, word_length )) %&gt;%<br />
	mutate( word_length = ifelse( word_length &lt; 2, 2, word_length )) %&gt;%<br />
	group_by( folio, word_length ) %&gt;%<br />
	summarise( count = n( )) %&gt;%<br />
	pivot_wider( names_from = word_length, values_from = count ) %&gt;%<br />
	ungroup %&gt;%<br />
	select( -c(&quot;folio&quot;, &quot;5&quot;, &quot;6&quot;, &quot;7&quot;, &quot;8&quot;, &quot;9&quot; )) %&gt;%<br />
	select(sort(peek_vars())) %&gt;%<br />
	replace( is.na(.), 0 )</p>
<p>if( not( file.exists( &quot;work/multinomial_changepoint_voynich_fit.rds&quot; ) ) ) {</p>
<p>	message( &quot;Fitting multinomial model.&quot;)<br />
	voynich_seed &lt;- 1912<br />
	num_cats &lt;- ncol( voynich_lengths )<br />
	voynich_multinomial_fit &lt;-<br />
		stan( &quot;multinomial_changepoint.stan&quot;,<br />
			  data=list(<br />
							num_obs=226,<br />
							num_cats=num_cats,<br />
							y = as.matrix( voynich_lengths ),<br />
							alpha = rep( 0.6, num_cats ) ),<br />
			  chains=4,<br />
			  iter=8000, seed=voynich_seed,<br />
			  control = list( adapt_delta=0.99,<br />
								  	max_treedepth=12 ) )</p>
<p>	saveRDS( voynich_multinomial_fit, &quot;work/multinomial_changepoint_voynich_fit.rds&quot; )</p>
<p>} else {<br />
	message( &quot;Loading saved multinomial model.&quot;)<br />
	voynich_multinomial_fit &lt;- readRDS( &quot;work/multinomial_changepoint_voynich_fit.rds&quot; )<br />
}</p>
<p># Plot the calculated changepoint probabilities.<br />
# (&#8216;changepoint_simplex&#8217;).<br />
mean_changepoint_prob &lt;-<br />
	extract( voynich_multinomial_fit )$changepoint_simplex %&gt;%<br />
	as_tibble( .name_repair=&quot;unique&quot; ) %&gt;%<br />
	summarise_all( mean ) %&gt;%<br />
	pivot_longer( everything() ) %&gt;%<br />
	rowid_to_column() </p>
<p># Plot the calculated changepoint probabilities.<br />
# (&#8216;changepoint_simplex&#8217;).<br />
mean_log_p &lt;-<br />
	extract( voynich_multinomial_fit )$log_p %&gt;%<br />
	as_tibble( .name_repair=&quot;unique&quot; ) %&gt;%<br />
	summarise_all( mean ) %&gt;%<br />
	pivot_longer( everything() ) %&gt;%<br />
	rowid_to_column() </p>
<p># Save mean values for plotting<br />
saveRDS( mean_changepoint_prob, file=&quot;work/mean_changepoint_prob_voynich.rds&quot; )</p>
[/code]
</div></div>
</div>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Voynich Manuscript data file</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_raw.csv">Voynich Manuscript formatted raw text data.</a></p>
</div></div>
</div>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Voynich Manuscript changepoint plot code</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>multinomial_changepoint_voynich_plot.r</code><br />
[code language=&#8221;r&#8221;]
<p>library( tidyverse )<br />
library( magrittr )</p>
<p>library( ggthemes )<br />
library( showtext )</p>
<p>library( cowplot )<br />
library( grimoire ) # https://github.com/weirddatascience/grimoire</p>
<p># Fonts<br />
font_add( &quot;voynich_font&quot;, &quot;resources/fonts/voynich/eva1.ttf&quot;)<br />
font_add( &quot;main_font&quot;, &quot;resources/fonts/alchemy/1651 Alchemy/1651AlchemyNormal.otf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;resources/fonts/alchemy/1651 Alchemy/1651AlchemyNormal.otf&quot;)</p>
<p>showtext_auto()</p>
<p>mean_changepoint_prob &lt;-<br />
	readRDS( &quot;work/mean_changepoint_prob_voynich.rds&quot; )</p>
<p>changepoint_plot &lt;-<br />
	ggplot( mean_changepoint_prob ) +<br />
	geom_col( aes( x=rowid, y=value ), fill=weird_colours[&quot;blood&quot;] ) +<br />
	labs( x=&quot;Folio&quot;, y=&quot;Probability of Changepoint&quot; ) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;transparent&quot;, colour = &quot;transparent&quot;),<br />
			plot.background = element_rect(fill = &quot;transparent&quot;, colour = &quot;transparent&quot;),<br />
			plot.title = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=22 ),<br />
			plot.subtitle = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.text = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.title.x = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.title.y = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], angle=90, size=12 ),<br />
			axis.line = element_line( colour=weird_colours[&quot;ink&quot;] ),<br />
			panel.grid.major.x = element_blank(),<br />
			panel.grid.major.y = element_blank(),<br />
			panel.grid.minor.x = element_blank(),<br />
			panel.grid.minor.y = element_blank()<br />
			) </p>
<p># grimoire::decorate_plot() from &lt;https://github.com/weirddatascience/grimoire&gt;<br />
parchment_plot &lt;-<br />
	decorate_plot(<br />
					  title=&quot;Voynich Folio Word-Length Changepoint&quot;,<br />
					  subtitle=&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;,<br />
					  plot=changepoint_plot,<br />
					  bg_image=&quot;resources/img/parchment.jpg&quot;,<br />
					  footer=&quot;Data: http://www.voynich.nu&quot; )</p>
<p>save_plot(&quot;output/multinomial_changepoint_voynich_plot.pdf&quot;,<br />
							parchment_plot,<br />
							base_width = 16,<br />
							base_height = 9,<br />
			           	base_aspect_ratio = 1.78 )</p>
[/code]
</div></div>
</div>
<p>Our model appears to identify a potential changepoint in the frequency of short words in the Voynich Manuscript somewhere around Folio 33.</p>
<p>In contrast to the analysis of <em>Tirant lo Blanc</em>, we have no <em>a priori</em> suspicion that multiple authors were involved in the creation of the Voynich Manuscript. As such, we may hypothesise this changepoint as reflecting a simple stylistic shift, a shift in content, or, as with the previous analysis, a shift in authorship.</p>
<h2>Mutatis Mutandis</h2>
<p>Recalling the topic model from the <a href="https://www.weirddatascience.net/2019/12/24/illuminating-the-illuminated-part-three-topics-of-invention-topic-modelling-the-voynich-manuscript/">previous post</a>, and the manually-assigned topics hinted at by the diagrams in the manuscript, Folio 33 might not immediately arouse our suspicions as the most obvious candidate for such a shift in style, falling as it does some way through the manually-identified herbal section, and without an immediately apparent shift in the distribution of topics.</p>
<p>For simplicity of presentation and analysis we will work with the alternative 12-topic model suggested by the metrics in the previous post rather than the 34-topic model initially given there<span id='easy-footnote-4-2009' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/#easy-footnote-bottom-4-2009' title='We have reproduced the analyses in this post for the 34-topic model with similar results.'><sup>4</sup></a></span>. The distribution of topics in this model can be presented as those of the 34-topic model were in our previous post.</p>
<figure id="attachment_2073" aria-describedby="caption-attachment-2073" style="width: 1920px" class="wp-caption aligncenter"><a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12.png"><img loading="lazy" decoding="async" data-attachment-id="2073" data-permalink="https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/voynich_folio_topic_heatmap-12-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="voynich_folio_topic_heatmap-12" data-image-description="&lt;p&gt;Voynich folio-topic heatmap&lt;/p&gt;
" data-image-caption="&lt;p&gt;Voynich folio-topic heatmap&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12-1024x576.png" src="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12.png" alt="Voynich Manuscript Folio Topic Heatmap" width="1920" height="1080" class="size-full wp-image-2073" srcset="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12-1536x864.png 1536w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12-678x381.png 678w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-2073" class="wp-caption-text">Voynich Manuscript Folio Topic Heatmap | (<a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_topic_heatmap-12.pdf">PDF Version</a>)</figcaption></figure>
<p>We might, then, ask whether the distribution of topics from this model itself has a changepoint. Having interrogated the distribution of word length frequencies, we can pose the same questions to the distribution of assignments produced by the topic model. Similarly to above: were we to conceive of the topic model assignment for each page as being the result of the roll of some biased die, is there a notable point in the document where the bias of that die seems to shift?</p>
<p>Framed as such, there is little more required to apply this model to the topic assignments. Our Stan model, dredged from its slumber, merely needs to be provided with the topic model folio assignment data.</p>
<figure id="attachment_2061" aria-describedby="caption-attachment-2061" style="width: 1920px" class="wp-caption aligncenter"><a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot.png"><img loading="lazy" decoding="async" data-attachment-id="2061" data-permalink="https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/multinomial_changepoint_voynich_topic-12_plot-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="multinomial_changepoint_voynich_topic-12_plot" data-image-description="&lt;p&gt;Voynich Manuscript topic model changepoint&lt;/p&gt;
" data-image-caption="&lt;p&gt;Voynich Manuscript topic model changepoint&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot-1024x576.png" src="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot.png" alt="Voynich Manuscript topic model changepoint" width="1920" height="1080" class="size-full wp-image-2061" srcset="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot-1536x864.png 1536w, https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot-678x381.png 678w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-2061" class="wp-caption-text">Voynich Manuscript topic model changepoint | (<a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/multinomial_changepoint_voynich_topic-12_plot.pdf">PDF Version</a>)</figcaption></figure>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Voynich Manuscript topic model changepoint code</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>multinomial_changepoint_voynich_topics.r</code><br />
[code language=&#8221;r&#8221;]
<p>library( tidyverse )<br />
library( tidyselect )<br />
library( magrittr )</p>
<p>library( rstan )<br />
library( tidytext )</p>
<p>library( gtools )		# (Specifically for `mixedsort` to sort column names numerically.</p>
<p># Number of topics in model<br />
num_topics &lt;- 12</p>
<p># Load Voynich topic model data<br />
message( &quot;Reading Voynich topic model data&#8230;&quot; )<br />
voynich_tbl &lt;-<br />
	readRDS( paste0( &quot;work/topic_identity-&quot;, num_topics, &quot;.rds&quot; )) %&gt;%<br />
	select( -c( &quot;gamma&quot;, &quot;section&quot; ) ) %&gt;%<br />
	ungroup</p>
<p># Pivot the data wider to be presented to Stan as a matrix of samples from a multinomial.<br />
voynich_lengths &lt;-<br />
	voynich_tbl %&gt;%<br />
	mutate( count=1 ) %&gt;%<br />
	pivot_wider( names_from = topic, values_from = &quot;count&quot; ) %&gt;%<br />
	select( -document ) %&gt;%<br />
	select(mixedsort(peek_vars())) %&gt;%<br />
	replace( is.na(.), 0 )</p>
<p>topic_fit_file &lt;- paste0( &quot;work/multinomial_changepoint_voynich_topic_fit-&quot;, num_topics, &quot;.rds&quot; )<br />
if( not( file.exists( topic_fit_file ) ) ) {</p>
<p>	message( &quot;Fitting multinomial model.&quot;)<br />
	voynich_topic_multinom_fit &lt;-<br />
		stan( &quot;multinomial_changepoint.stan&quot;,<br />
			  data=list(<br />
							num_obs=226,<br />
							num_cats=num_topics,<br />
							y = as.matrix( voynich_lengths ),<br />
							alpha = rep( 1, num_topics ) ),<br />
			  iter=8000,<br />
			  seed=19300319,<br />
			  control=list( adapt_delta=0.9 ) )<br />
	saveRDS( voynich_multinom_fit, topic_fit_file )</p>
<p>} else {<br />
	message( &quot;Loading saved multinomial model.&quot;)<br />
	voynich_multinom_fit &lt;- readRDS( topic_fit_file )<br />
}</p>
<p># Extract the calculated changepoint probabilities to a simplex.<br />
mean_changepoint_prob &lt;-<br />
	extract( voynich_multinom_fit )$changepoint_simplex %&gt;%<br />
	as_tibble( .name_repair=&quot;unique&quot; ) %&gt;%<br />
	summarise_all( mean ) %&gt;%<br />
	pivot_longer( everything() ) %&gt;%<br />
	rowid_to_column() </p>
<p># Save values for plotting<br />
saveRDS( mean_changepoint_prob, file=paste0( &quot;work/mean_changepoint_prob_voynich_topic-&quot;, num_topics, &quot;.rds&quot; ) )</p>
[/code]
</div></div>
</div>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Voynich Manuscript topic model changepoint plot code</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>multinomial_changepoint_voynich_topics_plot.r</code><br />
[code language=&#8221;r&#8221;]
<p>library( tidyverse )<br />
library( magrittr )</p>
<p>library( ggthemes )<br />
library( showtext )</p>
<p>library( cowplot )<br />
library( grimoire ) # https://github.com/weirddatascience/grimoire</p>
<p># Fonts<br />
font_add( &quot;voynich_font&quot;, &quot;resources/fonts/voynich/eva1.ttf&quot;)<br />
font_add( &quot;main_font&quot;, &quot;resources/fonts/alchemy/1651 Alchemy/1651AlchemyNormal.otf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;resources/fonts/alchemy/1651 Alchemy/1651AlchemyNormal.otf&quot;)</p>
<p>showtext_auto()</p>
<p># Specify the number of topics in the model<br />
num_topics &lt;- 12</p>
<p>mean_changepoint_prob &lt;-<br />
	readRDS( paste0(&quot;work/mean_changepoint_prob_voynich_topic-&quot;, num_topics, &quot;.rds&quot; ) )</p>
<p>changepoint_plot &lt;-<br />
	ggplot( mean_changepoint_prob ) +<br />
	geom_col( aes( x=rowid, y=value ), fill=weird_colours[&quot;blood&quot;] ) +<br />
	labs( x=&quot;Folio&quot;, y=&quot;Probability of Changepoint&quot; ) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;transparent&quot;, colour = &quot;transparent&quot;),<br />
			plot.background = element_rect(fill = &quot;transparent&quot;, colour = &quot;transparent&quot;),<br />
			plot.title = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=22 ),<br />
			plot.subtitle = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.text = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.title.x = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], size=12 ),<br />
			axis.title.y = element_text( family=&quot;bold_font&quot;, colour=weird_colours[&quot;ink&quot;], angle=90, size=12 ),<br />
			axis.line = element_line( colour=weird_colours[&quot;ink&quot;] ),<br />
			panel.grid.major.x = element_blank(),<br />
			panel.grid.major.y = element_blank(),<br />
			panel.grid.minor.x = element_blank(),<br />
			panel.grid.minor.y = element_blank()<br />
			) </p>
<p># grimoire::decorate_plot() from &lt;https://github.com/weirddatascience/grimoire&gt;<br />
parchment_plot &lt;-<br />
	decorate_plot(<br />
					  title=paste0( &quot;Voynich Folio Changepoint Probability &#8211; Topic Model (&quot;, num_topics, &quot; topics)&quot;),<br />
					  subtitle=&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;,<br />
					  plot=changepoint_plot,<br />
					  bg_image=&quot;resources/img/parchment.jpg&quot;,<br />
					  footer=&quot;Data: http://www.voynich.nu&quot;,<br />
						rel_heights=c(0.1, 1, 0.05 ))</p>
<p>save_plot( paste0(&quot;output/multinomial_changepoint_voynich_topic-&quot;, num_topics, &quot;_plot.pdf&quot; ),<br />
							parchment_plot,<br />
							base_width = 16,<br />
							base_height = 9,<br />
			           	base_aspect_ratio = 1.78 )</p>
[/code]
</div></div>
</div>
<p>The location suggested for the topic model changepoint are surprisingly close to the results of the changepoint for the frequency counts of short words in the Voynich Manuscript. Whilst the changepoint probabilities are somewhat more diffuse in the topic model analysis, the most significant probability mass is centered around Folio 38, with much lower spikes extending out as far as Folio 55 and Folio 30.</p>
<p>In addition to the mutual support that these two analyses provide, it is notable that the major changpoint identified by both falls directly in the earlier portion of the first, major &#8220;herbal&#8221; section identified manually by Voynich scholars through inspection of the images accompanying the text. This suggests that that first section, at least in terms of textual content, is not as homogeneous as has previously been suggested. Future scholars investigating the structure of the Voynich Manuscript may therefore wish to direct more attention towards the earlier middle of the herbal section, around folios 30 to 40, to identify what dreadful changes may emerge at that point in the text.</p>
<p>We might naturally, but do not here, extend this analysis by shattering further the smooth unity of the Manuscript according to <em>multiple</em> changepoints. Such an extension is, as intimated in the <a href="https://mc-stan.org/docs/2_21/stan-users-guide/change-point-section.html">guide</a>, conceptually simple but computationally burdensome, as it requires recalculation of multiple potential distributions across an ever increasing number of parameters. As such, we leave this analysis, and the means to conduct it more efficiently, for the dim future.</p>
<h2>Omnia mutantur, nihil interit</h2>
<p>Our analysis has provided us with an abstracted location in the text at which our unsettling suspicions of change lie. The two folios arousing greatest curiosity are therefore Folio 33 and Folio 38, which we present here to reify our horror. It is worth highlighting, however, that the changepoint analysis says nothing specific about these two folios; the model identifies that the inexplicable scrawling prior to the changepoint differs significantly from the maddeningly incomprehensible glyphs following it, nothing more.</p>
<figure id="attachment_2066" aria-describedby="caption-attachment-2066" style="width: 2560px" class="wp-caption aligncenter"><a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-scaled.jpg"><img loading="lazy" decoding="async" data-attachment-id="2066" data-permalink="https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/voynich_folio_33/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-scaled.jpg" data-orig-size="2560,1732" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="voynich_folio_33" data-image-description="&lt;p&gt;Voynich Folio 33&lt;/p&gt;
" data-image-caption="&lt;p&gt;Voynich Folio 33&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-1024x693.jpg" src="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-scaled.jpg" alt="Voynich Folio 33" width="2560" height="1732" class="size-full wp-image-2066" srcset="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-scaled.jpg 2560w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-300x203.jpg 300w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-1024x693.jpg 1024w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-768x520.jpg 768w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-1536x1039.jpg 1536w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_33-2048x1386.jpg 2048w" sizes="auto, (max-width: 2560px) 100vw, 2560px" /></a><figcaption id="caption-attachment-2066" class="wp-caption-text">Voynich Folio 33</figcaption></figure>
<figure id="attachment_2067" aria-describedby="caption-attachment-2067" style="width: 2560px" class="wp-caption aligncenter"><a href="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-scaled.jpg"><img loading="lazy" decoding="async" data-attachment-id="2067" data-permalink="https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/voynich_folio_38/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-scaled.jpg" data-orig-size="2560,1715" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="voynich_folio_38" data-image-description="&lt;p&gt;Voynich Folio 38&lt;/p&gt;
" data-image-caption="&lt;p&gt;Voynich Folio 38&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-1024x686.jpg" src="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-scaled.jpg" alt="Voynich Folio 38" width="2560" height="1715" class="size-full wp-image-2067" srcset="https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-scaled.jpg 2560w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-300x201.jpg 300w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-1024x686.jpg 1024w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-768x515.jpg 768w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-1536x1029.jpg 1536w, https://www.weirddatascience.net/wp-content/uploads/2020/02/voynich_folio_38-2048x1372.jpg 2048w" sizes="auto, (max-width: 2560px) 100vw, 2560px" /></a><figcaption id="caption-attachment-2067" class="wp-caption-text">Voynich Folio 38</figcaption></figure>
<p>The statistical properties that we have uncovered in the Voynich Manuscript over the past four posts reveal something of its inner structure. It supports, but cannot prove, that the Manuscript is not a hoax, and that it the text is most likely drawn from some natural language.</p>
<p>The changepoint analyses in this post are a powerful tool for identifying evolution and mutation in data, and the demonstrated example of stylometric analysis to Martorel&#8217;s <em>Tirant lo Blanc</em> support their use in revealing points of fracture in texts, without reference to the source language.</p>
<p>With specific relevant to the Voynich Manuscript, both the word frequency changepoint and the topic model changepoint suggest that the manscript&#8217;s contents shift significantly at some point around Folios 30 to 40. Given the previous assignment of topics based on manual identification of images accompanying the text, this presents a new avenue of investigation for Voynich researchers.</p>
<p>We have resisted that tantalising draw of attempts to translate the Voynich Manuscript. The tools we have applied are more broadly statistical and aim at unveiling structures and revealing patterns in the text; whilst they may provide information towards deciphering the text, that particular conundrum is for the future.</p>
<p>There are, as we would always wish, many avenues left unexplored in this particular labyrinth. The topic model is crude, and more subtle disassemblies could well provide a more refined view. The word frequency patterns support natural language, but we have not made any effort to correlate them with known languages. We have treated words as a unit of analysis, but have not looked in detail at the structure of likely prefixes and suffixes; similar words with differing endings are particularly notable in the topic model, and analysis of these could reveal much more than we have dared to attempt.</p>
<p>There could be much to learn from assessing multiple changepoints in the Manuscript. The presentation of the volume certainly supports its composition of multiple disparate sections; perhaps identifying an inexorable sequence of stylistic shifts could unveil still more of this structure.</p>
<p>For now, however, our meandering journey into the dim twilight of the Voynich Manuscript has drawn to a close, leaving us still searching for illumination in the shadows of this most <a href="https://www.nsa.gov/Portals/70/documents/about/cryptologic-heritage/historical-figures-publications/publications/misc/voynich_manuscript.pdf">elegant enigma</a>.</p>
<p>Continue to search, in fear of what you may find.</p>
<hr />
<p>Code and data for this post: <a href="https://github.com/weirddatascience/weirddatascience/tree/master/20200220-voynich04-tempora_mutantur">https://github.com/weirddatascience/weirddatascience/tree/master/20200220-voynich04-tempora_mutantur</a>.</p>
<hr />
<h2>Footnotes</h2>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2020/02/21/illuminating-the-illuminated-part-four-tempora-mutantur-changepoint-analysis-of-the-voynich-manuscript/feed/</wfw:commentRss>
			<slash:comments>1</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">2009</post-id>	</item>
		<item>
		<title>Bayes vs. the Invaders! Part Four: Convergence</title>
		<link>https://www.weirddatascience.net/2019/04/28/bayes-vs-the-invaders-part-four-convergence/</link>
					<comments>https://www.weirddatascience.net/2019/04/28/bayes-vs-the-invaders-part-four-convergence/#respond</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Sun, 28 Apr 2019 08:38:43 +0000</pubDate>
				<category><![CDATA[beyond the veil]]></category>
		<category><![CDATA[stan]]></category>
		<category><![CDATA[ufo]]></category>
		<guid isPermaLink="false">http://www.weirddatascience.net/?p=728</guid>

					<description><![CDATA[<div class="mh-excerpt">In the previous three posts in our series delving into the cosmic horror of UFO sightings in the United States, we have descended from the deceptively warm and sunlit waters of basic linear regression, through the increasingly frigid, stygian depths of Bayesian inference, generalised linear models, and the probabilistic programming language Stan. In this final post we will explore the implications of the murky realms in which we find ourselves, and consider the awful choices that have led us to this point. We will therefore look, with merciful brevity, at the foul truth revealed by our models, but also consider the arcane philosophies that lie sleeping beneath.</div> <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2019/04/28/bayes-vs-the-invaders-part-four-convergence/" title="Bayes vs. the Invaders! Part Four: Convergence">[...]</a>]]></description>
										<content:encoded><![CDATA[<h1>Sealed and Buried</h1>
<p>In the previous three posts<span id='easy-footnote-5-728' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/28/bayes-vs-the-invaders-part-four-convergence/#easy-footnote-bottom-5-728' title='To immerse yourself in the full horror of our journey, the previous posts in this series are here: &lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;&lt;a href=&quot;https://www.weirddatascience.net/index.php/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/&quot;&gt;Bayes vs. the Invaders! Part One: The 37th Parallel&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&quot;https://www.weirddatascience.net/index.php/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/&quot;&gt;Bayes vs. the Invaders! Part Two: Abnormal Distributions&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&quot;https://www.weirddatascience.net/index.php/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/&quot;&gt;Bayes vs. the Invaders! Part Three: The Parallax View&lt;/a&gt;&lt;/li&gt;
&lt;/ul&gt;
'><sup>5</sup></a></span> in our series delving into the cosmic horror of UFO sightings in the US, we have descended from the deceptively warm and sunlit waters of basic linear regression, through the increasingly frigid, stygian depths of Bayesian inference, generalised linear models, and the probabilistic programming language Stan.</p>
<p>In this final post we will explore the implications of the murky realms in which we find ourselves, and consider the awful choices that have led us to this point. We will therefore look, with merciful brevity, at the foul truth revealed by our models, but also consider the arcane philosophies that lie sleeping beneath.</p>
<h1>Deviant Interpretations</h1>
<p>Our crazed wanderings through dark statistical realms have led us eventually to a <a href="https://www.weirddatascience.net/index.php/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/">varying slope, varying intercept negative binomial generalised linear model</a>, whose selection was justified over its simpler cousins via leave-one-out cross-validation (LOO-CV). By interrogating the range of hyperparameters of this model, we could reproduce an alluringly satisfying visual display of the posterior predictive distribution across the United States:</p>
<figure id="attachment_703" aria-describedby="caption-attachment-703" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.png"><img loading="lazy" decoding="async" data-attachment-id="703" data-permalink="https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/predictive_plot-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="bvi03-predictive_plot" data-image-description="" data-image-caption="&lt;p&gt;Varying intercept and slope negative binomial GLM of UFO sightings against population.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.png" alt="" width="1920" height="1080" class="size-full wp-image-703" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-703" class="wp-caption-text">Varying intercept and slope negative binomial GLM of UFO sightings against population. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.pdf">PDF Version</a>)</figcaption></figure>
<p>Further, our model provides us with insight into the individual per-state intercept &#92;(\alpha&#92;) and slope &#92;(\beta&#92;) parameters of the underlying linear model, demonstrating that there is variation between the rate of sightings in US states that cannot be accounted for by their ostensibly human population.</p>
<figure id="attachment_705" aria-describedby="caption-attachment-705" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.png"><img loading="lazy" decoding="async" data-attachment-id="705" data-permalink="https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/ufo_per-state_intercepts-slopes/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="ufo_per-state_intercepts-slopes" data-image-description="" data-image-caption="&lt;p&gt;Varying slope and intercept negative binomial GLM parameter plot.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.png" alt="" width="1920" height="1080" class="size-full wp-image-705" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-705" class="wp-caption-text">Varying slope and intercept negative binomial GLM parameter plot for UFO sightings model. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.pdf">PDF Version</a>)</figcaption></figure>
<p>Interpreting these parameters, however, is not as quite as simple as in a basic linear model<span id='easy-footnote-6-728' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/28/bayes-vs-the-invaders-part-four-convergence/#easy-footnote-bottom-6-728' title='One advantage of generalised linear models is that they allow flexibility whilst remaining relatively interpretable. As models become more complex, extending generalised linear models (GLMs) through generalised &lt;em&gt;additive&lt;/em&gt; models (GAMs), and further into the vast chaotic mass of machine learning approaches such as random forests and convolutional neural networks, there is a general tradeoff between the terrifying power of the modelling technique and the ability of the human mind to &lt;a href=&quot;TODO:call_of_cthulhu&quot;&gt;correlate its contents&lt;/a&gt;.'><sup>6</sup></a></span>. Most importantly our negative binomial GLM employs a <em>log link</em> function to relate the linear model to the data:</p>

$$\begin{eqnarray}<br />
y &amp;\sim&amp; \mathbf{NegBinomial}(\mu, \phi)&#92;&#92;<br />
\log(\mu) &amp;=&amp; \alpha + \beta x&#92;&#92;<br />
\alpha &amp;\sim&amp; \mathcal{N}(0, 1)&#92;&#92;<br />
\beta &amp;\sim&amp; \mathcal{N}(0, 1)&#92;&#92;<br />
\phi &amp;\sim&amp; \mathbf{HalfCauchy}(2)<br />
\end{eqnarray}$$</p>
<p>In a basic linear regression, &#92;(y=\alpha+\beta x&#92;), the &#92;(\alpha&#92;) parameter can be interpreted as the value of &#92;(y&#92;) when &#92;(x&#92;) is 0. Increasing the value of &#92;(x&#92;) by 1 results in a change in the &#92;(y&#92;) value of &#92;(\beta&#92;). We have, however, been drawn far beyond such naive certainties.</p>
<p>The &#92;(\alpha&#92;&#41; and &#92;(\beta&#92;) coefficients in our negative binomial GLM produce the &#92;(\log&#92;) of the &#92;(y&#92;) value: the <em>mean</em> of the negative binomial in our parameterisation.</p>
<p>With a simple rearrangement, we can being to understand the grim effects of this transformation:</p>
<p>$$\begin{array}<br />
_ &amp; \log(\mu) &amp;=&amp; \alpha + \beta x&#92;&#92;<br />
\Rightarrow &amp;\mu &amp;=&amp; \operatorname{e}^{\alpha + \beta x}&#92;&#92;<br />
\end{array}$$</p>
<p>If we set &#92;(x=0&#92;):</p>
<p>$$\begin{eqnarray}<br />
\mu_0 &amp;=&amp; \operatorname{e}^{\alpha}<br />
\end{eqnarray}$$</p>
<p>The mean of the negative binomial when &#92;(x&#92;) is 0 is therefore &#92;(\operatorname{e}^{\alpha&#125;&#92;). If we increase the value of &#92;(x&#92;) by 1:</p>
<p>$$\begin{eqnarray}<br />
\mu_1 &amp;=&amp; \operatorname{e}^{\alpha + \beta}&#92;&#92;<br />
&amp;=&amp; \operatorname{e}^{\alpha} \operatorname{e}^{\beta}<br />
\end{eqnarray}$$</p>
<p>Which, if we recall the definition of the underlying mean of our model&#8217;s negative binomial, &#92;(\mu_0&#92;), above, is:<br />
$$\mu_0 \operatorname{e}^{\beta}$$</p>
<p>The effect of an increase in &#92;(x&#92;) is therefore <em>multiplicative</em> with a log link: each increase of &#92;(x&#92;) by 1 causes the mean of the negative binomial to be further multiplied by &#92;(\operatorname{e}^{\beta}&#92;).</p>
<p>Despite this insidious complexity, in many senses our naive interpretation of these values still holds true. A higher value for the &#92;(\beta&#92;) coefficient does mean that the rate of sightings increases more swiftly with population.</p>
<p>With the full, unsettling panoply of US States laid out before us, any attempt to elucidate their many and varied deviations would be overwhelming. Broadly, we can see that both slope and intercepts are generally restricted to a fairly close range, with the 50% and 95% credible intervals notably overlapping in many cases. Despite this, there are certain unavoidable abnormalities from which we cannot, must not, shrink:</p>
<ul>
<li> Only Pennsylvania presents a slope (\(\beta\)) parameter that could be considered as potentially zero, if we consider its 95% credible interval. The correlation between population and number of sightings is otherwise unambiguously positive.</li>
<li>Delaware, whilst presenting a wide credible interval for its slope (\(\beta\)) parameter, stands out as suffering from the greatest rate of change in sightings as its population increases.</li>
<li>Both California and Utah, present suspiciously narrow credible intervals on their slope (\(\beta\)) parameters. The growth in sightings as the population increases therefore demonstrates a worrying consistency although, in both cases, this rate is amongst the lowest of all the states.</li>
</ul>
<p>We can conclude, then, that while the <em>total</em> number of sightings in Delaware are currently low, any increase in numbers of residents there appears to possess a strange fascination for visitors from beyond the inky blackness of space. By contrast, whilst our alien observers have devoted significant resources to monitoring Utah and California, their apparent willingness to devote further effort to tracking those states&#8217; burgeoning populations is low.</p>
<h1>Trembling Uncertainty</h1>
<p>One of the fundamental elements of the Bayesian approach is its willing embrace of uncertainty. The output of our eldritch inferential processes are not <em>point estimates</em> of the outcome, as in certain other approaches, but instead <em>posterior predictive distributions</em> for those outcomes. As such, if when we turn our minds to predicting new outcomes based on previously unseen data, our outcome is a <em>distribution</em> over possible values rather than a single estimate. Thus, at the dark heart of Bayesian inference is a belief in the truth that all uncertainty be quantified as probability distributions.</p>
<p>The Bayesian approach as inculcated here has a <em>predictive</em> bent to it. These intricate methods lend themselves to forecasting a distribution of possibilities before the future unveils itself. Here, we gain a horrifying glimpse into the emerging occurrence of alien visitations to the US as its people <a href="https://www.goodreads.com/work/quotes/3194841-the-war-of-the-worlds">busy themselves about their various concerns, scrutinised and studied, perhaps almost as narrowly as a man with a microscope might scrutinise the transient creatures that swarm and multiply in a drop of water</a>.</p>
<h1>Unavoidable Choices</h1>
<p>The twisted reasoning underlying this series of posts has been not only in indoctrinating others into the hideous formalities of Bayesian inference, probabilistic programming, and the arcane subtleties of the <a href="https://www.mc-stan.org">Stan</a> programming language; but also as an exercise in exposing our own minds to their horrors. As such, there is a tentative method to the madness of some of the choices made in this series that we will now elucidate.</p>
<p>Perhaps the most jarring choice has been to code these models in Stan directly, rather than using one of the excellent helper libraries that allow for more concise generation of the underlying Stan code. Both <a href="https://cran.r-project.org/package=brms"><code>brms</code></a> and <a href="https://cran.r-project.org/package=rstanarm"><code>rstanarm</code></a> possess the capacity to spawn models such as ours with greater simplicity of specification and efficiency of output, due to a number of arcane tricks. As an exercise in internalising such forbidden knowledge, however, it is useful to address reality unshielded by such swaddling conveniences.</p>
<p>In fabricating models for more practical reasons, however, we would naturally turn to these tools unless our unspeakable demands go beyond their natural scope. As a personal choice, <code>brms</code> is appealing due to its more natural construction of readable per-model Stan code to be compiled. This allows for the grotesque internals of generated models to be inspected and, if required, twisted to whatever form we desire. <code>rstanarm</code>, by contrast, avoids per-model compilation by pre-compiling more generically applicable models, but its underlying Stan code is correspondingly more arcane for an unskilled neophyte.</p>
<p>The Stan models presented in previous posts have also been constructed as simply as possible and have avoided all but the most universally accepted tricks for improving speed and stability<span id='easy-footnote-7-728' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/28/bayes-vs-the-invaders-part-four-convergence/#easy-footnote-bottom-7-728' title='The most important of these are to center and scale our predictors, and to operate on the log scale through use of the &lt;code&gt;log&lt;/code&gt; form of the probability distribution sampling statements. Both of these contribute significantly to speed and numerical stability in sampling, and are sufficiently universal that their inclusion seemed justified.'><sup>7</sup></a></span>. Most notably, Stan presents specific functions for GLMs based on the Poisson and negative binomial distributions that apply standard link functions directly. As mentioned, we consider it more useful for personal and public indoctrination to use the basic, albeit <code>log</code>-form parameterisations.</p>
<h1>Last Rites</h1>
<p>In concluding the dark descent of this series of posts on Bayesian inference, generalised linear models, and the unearthly effects of extraterrestrial visitions on humanity, we have applied numerous esoteric techniques to identify, describe, and quantify the relationship between human population and UFO sightings. The enigmatic model constructed throughout this and the previous three entries darkly implies that, while the rate of inexplicable aerial phenomena is inextricably and positively linked to humanity&#8217;s unchecked growth, there are nonetheless unseen factors that draw our non-terrestrial visitors to certain populations more than others, and that their focus and attention is ever more acute.</p>
<p>This series has inevitably fallen short of a full and meaningful elucidation of the techniques of Bayesian inference and Stan. From this first step on such a path, then, interested students of the bizarre and arcane would be well advised to draw on the following esoteric resources:</p>
<ul>
<li>McElreath&#8217;s <a href="https://xcelab.net/rm/statistical-rethinking/">Statistical Rethinking</a></li>
<li>Gelman et al.&#8217;s <a href="http://www.stat.columbia.edu/~gelman/book/">Bayesian Data Analysis</a></li>
<li><a href="https://mc-stan.org/">Stan Manual and Tutorials</a></li>
</ul>
<p>Until then, watch the skies and archive your data.</p>
<h2>Footnotes</h2>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2019/04/28/bayes-vs-the-invaders-part-four-convergence/feed/</wfw:commentRss>
			<slash:comments>0</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">728</post-id>	</item>
		<item>
		<title>Bayes vs. the Invaders! Part Three: The Parallax View</title>
		<link>https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/</link>
					<comments>https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/#comments</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Wed, 17 Apr 2019 13:35:56 +0000</pubDate>
				<category><![CDATA[beyond the veil]]></category>
		<category><![CDATA[stan]]></category>
		<category><![CDATA[ufo]]></category>
		<guid isPermaLink="false">http://www.weirddatascience.net/?p=654</guid>

					<description><![CDATA[<div class="mh-excerpt">In the <a href="http://www.weirddatascience.net/index.php/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/">previous post</a> of this series unveiling the relationship between UFO sightings and population, we crossed the threshold of normality underpinning linear models to construct a <em>generalised linear model</em> based on the more theoretically satisfying Poisson distribution. On inspection, however, this model revealed itself to be less well suited to the data than we had, in our tragic ignorance, hoped.</div> <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/" title="Bayes vs. the Invaders! Part Three: The Parallax View">[...]</a>]]></description>
										<content:encoded><![CDATA[<h1>The Parallax View</h1>
<p>In the <a href="http://www.weirddatascience.net/index.php/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/">previous post</a> of this series unveiling the relationship between UFO sightings and population, we crossed the threshold of normality underpinning linear models to construct a <em>generalised linear model</em> based on the more theoretically satisfying Poisson distribution.</p>
<p>On inspection, however, this model revealed itself to be less well suited to the data than we had, in our tragic ignorance, hoped. While it appeared, on visual inspection, to capture some features of the data, the predictive posterior density plot demonstrated that it still fell short of addressing the subtleties of the original.</p>
<p>In this post, we will seek to overcome this sad lack in two ways: firstly, we will subject our models to pitiless mathematical scrutiny to assess their ability to describe the data. With our eyes irrevocably opened to these techniques, we will construct an ever more complex <a href="https://www.youtube.com/watch?v=yRb63jt4uzw">armillary</a> with which to approach the unknowable truth.</p>
<h1>Critical Omissions of Information</h1>
<p>Our previous post showed the different fit of the Poisson model to the data from the simple Gaussian linear model. When presented with a grim array of potential simulacra, however, it is crucial to have reliable and quantitative mechanisms to select amongst them.</p>
<p>The eldritch procedure most suited to this purpose, <em>model selection</em>, in our framework, draws on <em>information criteria</em> that express the <em>relative</em> effectiveness of models at creating sad mockeries of the original data. The original and most well-known such criterion is the <a href="https://en.wikipedia.org/wiki/Akaike_information_criterion"><em>Akaike Information Criterion</em></a>, which has, in turn, spawned a multitude of successors applicable in different situations and with different properties. Here, we will make use of <a href="https://mc-stan.org/loo/"><em>Leave-One-Out Cross Validation</em></a> (LOO-CV)<span id='easy-footnote-8-654' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/#easy-footnote-bottom-8-654' title='Specifically, leave-one-out cross validation calculated via &lt;a href=&quot;https://arxiv.org/abs/1507.04544&quot;&gt;&lt;em&gt;Pareto-smoothed importance sampling&lt;/em&gt;&lt;/a&gt;.'><sup>8</sup></a></span> as the most applicable to the style of model and set of techniques applied here.</p>
<p>It is important to reiterate that these approaches do not speak to an absolute underlying truth; information criteria allow us to choose between models, assessing which has most closely assimilated the madness and chaos of the data. For LOO-CV, this results in an <em>expected log predictive density</em> (<code>elpd</code>) for each model. The model with the lowest <code>elpd</code> is the least-warped mirror of reality amongst those we subject to scrutiny.</p>
<p>There are many fragile subtleties to model selection, of which we will mention only two here. Firstly, in general, the greater the number of predictors or variables incorporated into a model, the more closely it will be able to mimic the original data. This is problematic, in that a model can become <em>overfit</em> to the original data and thus be unable to represent previously unseen data accurately &#8212; it learns to mimic the form of the observed data at the expense of uncovering its underlying reality. The LOO-CV technique avoids this trap by, in effect, withholding data from the model to assess its ability to make accurate inferences on previously unseen data.</p>
<p>The second consideration in model selection is that the information criteria scores of models, such as (<code>elpd</code>) in LOO-CV, are subject to <em>standard error</em> in their assessment; the score itself is not a perfect metric of model performance, but a cunning approximation. As such we will only consider one model to have outperformed its competitors if the difference in their relative <code>elpd</code> is several times greater than this standard error.</p>
<p>With this understanding in hand, we can now ruthlessly quantify the effectiveness of the Gaussian linear model against the Poisson generalised linear model.</p>
<h1>Gaussian vs. the Poisson</h1>
<p>The original model presented before our subsequent descent into horror was a simple linear Gaussian, produced through use of <code>ggplot2</code>&#8216;s <code>geom_smooth</code> function. To compare this meaningfully against the Poisson model of the previous post, we must now recreate this model using the, now hideously familar, tools of Bayesian modelling with Stan.</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show Gaussian model specification code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>population_model_normal.stan</code><br />
[code language=&#8221;c&#8221;]
<p>data {</p>
<p>	// Number of rows (observations)<br />
	int&lt;lower=1&gt; observations;</p>
<p>	// Predictor (population of state)<br />
	vector[ observations ] population;</p>
<p>	// Response (counts)<br />
	real&lt;lower=0&gt; counts[observations];</p>
<p>}</p>
<p>parameters {</p>
<p>	// Intercept<br />
	real&lt; lower=0 &gt; a;</p>
<p>	// Slope<br />
	real&lt; lower=0 &gt; b;</p>
<p>	// Standard deviation<br />
	real&lt; lower=0 &gt; sigma;<br />
}</p>
<p>model {</p>
<p>	// Priors<br />
	a ~ normal( 0, 5 );<br />
	b ~ normal( 0, 5 );<br />
	sigma ~ cauchy( 0, 2.5 );</p>
<p>	// Model<br />
	counts ~ normal( a + population * b, sigma );</p>
<p>}</p>
<p>generated quantities {</p>
<p>	// Posterior predictions<br />
	vector[observations] counts_pred;</p>
<p>	// Log likelihood (for LOO)<br />
	vector[observations] log_lik;</p>
<p>	for (n in 1:observations) {</p>
<p>		log_lik[n] = normal_lpdf( counts[n] | a + population[n]*b, sigma );<br />
		counts_pred[n] = normal_rng( a + population[n]*b, sigma );</p>
<p>	}</p>
<p>}</p>
[/code]
</div></div>
</div>
<p>With both models straining in their different directions towards the light, we apply LOO-CV cross validation to assess their effectiveness at predicting the data.</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show LOO-CV comparison code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p>LOO-CV R-code snippet. Full code is at the end of this post.<br />
[code language=&#8221;R&#8221;]
<p>&#8230;<br />
# Compare models with LOO<br />
log_lik_normal &lt;- extract_log_lik(fit_ufo_pop_normal, merge_chains = FALSE)<br />
r_eff_normal &lt;- relative_eff(exp(log_lik_normal))<br />
loo_normal &lt;- loo(log_lik_normal, r_eff = r_eff_normal, cores = 2)</p>
<p>log_lik_poisson &lt;- extract_log_lik(fit_ufo_pop_poisson, merge_chains = FALSE)<br />
r_eff_poisson &lt;- relative_eff(exp(log_lik_poisson))<br />
loo_poisson &lt;- loo(log_lik_poisson, r_eff = r_eff_poisson, cores = 2)<br />
&#8230;</p>
[/code]
</div></div>
</div>
<pre class="brush: plain; title: ; notranslate">
&gt; compare( loo_normal, loo_poisson )
elpd_diff        se 
  -8576.1     712.5 
</pre>
<p>The information criterion shows that the complexity of the Poisson model does not, in fact, produce a more effective model than the false serenity of the Gaussian<span id='easy-footnote-9-654' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/#easy-footnote-bottom-9-654' title='This is perhaps not entirely surprising, based on our belief from the first post of this series that we should consider sightings at the state level rather than globally. With over fifty individual count processes fused into an amorphous mass, it is not entirely surprising that the &lt;a href=&quot;https://en.wikipedia.org/wiki/Central_limit_theorem&quot;&gt;Gaussian is a better approximation to the data&lt;/a&gt;.'><sup>9</sup></a></span>. The negative <code>elpd_diff</code> of the <code>compare</code> function supports the first of the two models, and the magnitude being over twelve times greater than the standard error leaves little doubt that the difference is significant. We must, it seems, look further.</p>
<p>With these techniques for selecting between models in hand, then, we can move on to constructing ever more complex attempts to dispel the darkness.</p>
<h1>Trials without End</h1>
<p>The Poisson distribution, whilst appropriate for many forms of count data, suffers from fundamental limits to its understanding. The single parameter of the Poisson, &#92;(\lambda&#92;), enforces that the mean and variance of the data are equal. When such comforting falsehoods wither in the pale light of reality, we must move beyond the gentle chains in which the Poisson binds us.</p>
<p>The next horrific evolution, then, is the <a href="https://en.wikipedia.org/wiki/Negative_binomial_distribution"><em>negative binomial</em></a> distribution, which similarly speaks to count data, but presents a <em>dispersion</em> parameter (&#92;(\phi&#92;)) that allows the variance to exceed the mean<span id='easy-footnote-10-654' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/#easy-footnote-bottom-10-654' title='There are several parameterisations of the negative binomial used for different applications. The distribution itself is often characterised as representing the number of binary trials, such as a coin flip, required before a given result, such as a number of heads, is achieved. The parameterisation we use here is a common way to represent &lt;em&gt;overdispersed&lt;/em&gt; Poisson data.'><sup>10</sup></a></span>.</p>
<p>With our arcane theoretical library suitably expanded, we can now transplant the still-beating Poisson heart of our earlier generalised linear model with the more complex machinery of the negative binomial:</p>

$$\begin{eqnarray}<br />
y &amp;\sim&amp; \mathbf{NegBinomial}(\mu, \phi)&#92;&#92;<br />
\log(\mu) &amp;=&amp; \alpha + \beta x&#92;&#92;<br />
\alpha &amp;\sim&amp; \mathcal{N}(0, 1)&#92;&#92;<br />
\beta &amp;\sim&amp; \mathcal{N}(0, 1)&#92;&#92;<br />
\phi &amp;\sim&amp; \mathbf{HalfCauchy}(2)<br />
\end{eqnarray}$$</p>
<p>As with the Poisson, our negative binomial generalised linear model employs a log link function to transform the linear predictor. The Stan code for this model is given below.</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show negative binomial model specification code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>population_model_negbinomial.stan</code><br />
[code language=&#8221;c&#8221;]
<p>data {</p>
<p>	// Number of rows (observations)<br />
	int&lt;lower=1&gt; observations;</p>
<p>	// Predictor (population of state)<br />
	vector[ observations ] population_raw;</p>
<p>	// Response (counts)<br />
	int&lt;lower=0&gt; counts[observations];</p>
<p>}</p>
<p>transformed data {</p>
<p>	// Center and scale the predictor<br />
	vector[ observations ] population;<br />
	population = ( population_raw &#8211; mean( population_raw ) ) / sd( population_raw );</p>
<p>}</p>
<p>parameters {</p>
<p>	// Negative binomial dispersion parameter<br />
	real phi;</p>
<p>	// Intercept<br />
	real a;</p>
<p>	// Slope<br />
	real b;</p>
<p>}</p>
<p>transformed parameters {</p>
<p>	vector&lt;lower=0&gt;[observations] mu;<br />
	mu = a + b*population;</p>
<p>}</p>
<p>model {</p>
<p>	// Priors<br />
	a ~ normal( 0, 1 );<br />
	b ~ normal( 0, 1 );<br />
	phi ~ cauchy( 0, 5 );</p>
<p>	// Model<br />
	// Uses the log version of the neg_binomial_2 to avoid<br />
	// manual exponentiation of the linear predictor.<br />
	// (This avoids numerical problems in the calculations.)<br />
	counts ~ neg_binomial_2_log( mu, phi );</p>
<p>}</p>
<p>generated quantities {</p>
<p>	vector[observations] counts_pred;<br />
	vector[observations] log_lik;</p>
<p>	for (n in 1:observations) {</p>
<p>		log_lik[n] = neg_binomial_2_log_lpmf( counts[n] | mu[n], phi );<br />
		counts_pred[n] = neg_binomial_2_log_rng( mu[n], phi );</p>
<p>	}</p>
<p>}</p>
[/code]
</div></div>
</div>
<p>With this model fit, we can compare its whispered falsehoods against both the original linear Gaussian model and the Poisson GLM:</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show LOO-CV comparison code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p>Code snippet for calculating the LOO-CV <code>elpd</code> for three models. The full R code for building and comparing all models is listed at the end of this post.</p>
[code]
[code language=&quot;R&quot;]
&#8230;<br />
# Compare models with LOO<br />
log_lik_normal &lt;- extract_log_lik(fit_ufo_pop_normal, merge_chains = FALSE)<br />
r_eff_normal &lt;- relative_eff(exp(log_lik_normal))<br />
loo_normal &lt;- loo(log_lik_normal, r_eff = r_eff_normal, cores = 2)</p>
<p>log_lik_poisson &lt;- extract_log_lik(fit_ufo_pop_poisson, merge_chains = FALSE)<br />
r_eff_poisson &lt;- relative_eff(exp(log_lik_poisson))<br />
loo_poisson &lt;- loo(log_lik_poisson, r_eff = r_eff_poisson, cores = 2)</p>
<p>log_lik_negbinom &lt;- extract_log_lik(fit_ufo_pop_negbinom, merge_chains = FALSE)<br />
r_eff_negbinom &lt;- relative_eff(exp(log_lik_negbinom))<br />
loo_negbinom &lt;- loo(log_lik_negbinom, r_eff = r_eff_negbinom, cores = 2)<br />
&#8230;<br />
[/code]
</div></div>
</div>
<pre class="brush: plain; title: ; notranslate">
&gt; compare( loo_poisson, loo_negbinom )
elpd_diff        se 
   8880.8     721.9 
</pre>
<p>With the first comparison, it is clear that the sinuous flexibility offered by the dispersion parameter, &#92;(\phi&#92;), of the negative binomial allows that model to mould itself much more effectively to the data than the Poisson. The <code>elpd_diff</code> score is positive, indicating that the second of the two compared models is favoured; the difference is over twelve times the standard error, giving us confidence that the negative binomial model is meaningfully more effective than the Poisson.</p>
<p>Whilst superior to the Poisson, does this adaptive capacity allow the negative binomial model to render the na&iuml;ve Gaussian linear model obsolete?</p>
<pre class="brush: plain; title: ; notranslate">
&gt; compare( loo_normal, loo_negbinom )
elpd_diff        se 
    304.7      30.9 
</pre>
<p>The negative binomial model subsumes the Gaussian with little effort. The <code>elpd_diff</code> is almost ten times the standard error in favour of the negative binomial GLM, giving us confidence in choosing it. From here on, we will rely on the negative binomial as the core of our schemes.</p>
<h1>Overlapping Realities</h1>
<p>The improvements we have seen with the negative binomial model allow us to discard the Gaussian and Poisson models with confidence. It is not, however, sufficient to fill the gaping void induced by our belief that the sightings of abnormal aerial phenomena in differing US states vary differently with their human population.</p>
<p>To address this question we must ascertain whether allowing our models to unpick the individual influence of states will improve their predictive ability. This, in turn, will lead us into the gnostic insanity of <em>hierarchical models</em>, in which we group predictors in our models to account for their shadowy underlying structures.</p>
<h1>Limpid Pools</h1>
<p>The first step on this path is to allow part of the linear function underpinning our model, specifically the intercept value, &#92;(\alpha&#92;), to vary between different US states. In a simple linear model, this causes the line of best fit for each state to meet the y-axis at a different point, whilst maintaining a constant slope for all states. In such a model, the result is a set of parallel lines of fit, rather than a single global truth.</p>
<p>This varying intercept can describe a range of possible phenomena for which the rate of change remains constant, but the baseline value varies. In such <em>hierarchical models</em> we employ a concept known as <em>partial pooling</em> to extract as much forbidden knowledge from the reluctant data as possible.</p>
<p>A set of entirely separate models, such as the per-state set of linear regressions presented in the first post of this series, employs a <em>no pooling</em> approach: the data of each state is treated separately, with an entirely different model fit to each. This certainly considers the uniqueness of each state, but cannot benefit from insights drawn from the broader range of data we have available, which we may reasonably assume to have some relevance.</p>
<p>By contrast, the global Gaussian, Poisson, and negative binomial models presented so far represent <em>complete pooling</em>, in which the entire set of data is considered a formless, protean amalgam without meaningful structure. This mindless, groping approach causes the unique features of each state to be lost amongst the anarchy and chaos.</p>
<p>A partial pooling approach instead builds a <em>global</em> mean intercept value across the dataset, but allows the intercept value for each individual state to deviate according to a governing probability distribution. This both accounts for the individuality of each group of observations, in our case the state, but also draws on the accumulated wisdom of the whole.</p>
<p>We now construct a partially-pooled varying intercept model, in which the parameters and observations for each US state in our dataset is individually indexed:</p>
<p>$$\begin{eqnarray}<br />
y &amp;\sim&amp; \mathbf{NegBinomial}(\mu, \phi)&#92;&#92;<br />
\log(\mu) &amp;=&amp; \alpha_i + \beta x&#92;&#92;<br />
\alpha_i &amp;\sim&amp; \mathcal{N}(\mu_\alpha, \sigma_\alpha)&#92;&#92;<br />
\beta &amp;\sim&amp; \mathcal{N}(0, 1)&#92;&#92;<br />
\phi &amp;\sim&amp; \mathbf{HalfCauchy}(2)<br />
\end{eqnarray}$$</p>
<p>Note that the intercept parameter, &#92;(\alpha&#92;), in the second line is now indexed by the state, represented here by the subscript &#92;(i&#92;). The slope parameter, &#92;(\beta&#92;), remains constant across all states.</p>
<p>This model can be rendered in Stan code as follows:</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show Gaussian model specification code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>population_model_negbinomial_var_intercept.stan</code><br />
[code language=&#8221;c&#8221;]
<p>data {</p>
<p>	// Number of rows (observations)<br />
	int&lt;lower=1&gt; observations;</p>
<p>	// Number of states<br />
	int&lt; lower=0 &gt; states;</p>
<p>	// Vector detailing the US state in which each observation (count of<br />
	// counts in a year) occurred<br />
	int&lt; lower=1, upper=states &gt; state[ observations ];</p>
<p>	// Predictor (population of state)<br />
	vector[ observations ] population_raw;</p>
<p>	// Response (counts)<br />
	int&lt;lower=0&gt; counts[ observations ];</p>
<p>}</p>
<p>transformed data {</p>
<p>	// Center and scale the predictor<br />
	vector[ observations ] population;<br />
	population = ( population_raw &#8211; mean( population_raw ) ) / sd( population_raw );</p>
<p>}</p>
<p>parameters {</p>
<p>	// Per-state intercepts<br />
	vector[ states ] a;</p>
<p>	// Mean and SD of distribution from which per-state intercepts are drawn<br />
	real&lt; lower=0 &gt; mu_a;<br />
	real&lt; lower=0 &gt; sigma_a;</p>
<p>	// Negative binomial dispersion parameter<br />
	real&lt; lower=0 &gt; phi;</p>
<p>	// Slope<br />
	real b;</p>
<p>}</p>
<p>transformed parameters {</p>
<p>	// Calculate location parameter for negative binomial incorporating<br />
	// per-state indicator.<br />
	vector[ observations ] eta;</p>
<p>	for( i in 1:observations ) {<br />
		eta[i] = a[ state[i] ] + population[i] * b;<br />
	}<br />
}</p>
<p>model {</p>
<p>	mu_a ~ normal(0, 1);<br />
	sigma_a ~ cauchy(0, 2);</p>
<p>	// Priors<br />
	a ~ normal ( mu_a, sigma_a );<br />
	b ~ normal( 0, 1 );<br />
	phi ~ cauchy( 0, 2 );</p>
<p>	// Model<br />
	counts ~ neg_binomial_2_log( eta, phi );</p>
<p>}</p>
<p>generated quantities {</p>
<p>	vector[observations] counts_pred;<br />
	vector[observations] log_lik;</p>
<p>	vector[observations] mu;<br />
	mu = exp( eta );</p>
<p>	for (n in 1:observations) {</p>
<p>		log_lik[n] = neg_binomial_2_log_lpmf( counts[n] | eta[n], phi );<br />
		counts_pred[n] = neg_binomial_2_log_rng( eta[n], phi );</p>
<p>	}</p>
<p>}</p>
[/code]
</div></div>
</div>
<p>Once the model has twisted itself into the most appropriate form for our data, we can now compare it against our previous completely-pooled model:</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show LOO-CV comparison code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p>Code snippet for comparing models via LOO-CV. Full code at the end of this post.</p>
[code]
&#8230;<br />
# Compare models with LOO<br />
log_lik_negbinom_var_intercept &lt;- extract_log_lik(fit_ufo_pop_negbinom_var_intercept, merge_chains = FALSE)<br />
r_eff_negbinom_var_intercept &lt;- relative_eff(exp(log_lik_negbinom_var_intercept))<br />
loo_negbinom_var_intercept &lt;- loo(log_lik_negbinom_var_intercept, r_eff = r_eff_negbinom_var_intercept, cores = 2)<br />
&#8230;<br />
[/code]
</div></div>
</div>
<pre class="brush: plain; title: ; notranslate">
&gt; compare( loo_negbinom, loo_negbinom_var_intercept )
elpd_diff        se 
    363.2      28.8 
</pre>
<p>Our transcendent journey from the statistical primordial ooze continues: the varying intercept model is favoured over the completely-pooled model by a significant margin.</p>
<h1>Sacred Geometry</h1>
<p>Now that our minds have apprehended a startling glimpse of the implications of the varying intercept model, it is natural to consider taking a further terrible step and allowing both the slope and the intercept to vary<span id='easy-footnote-11-654' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/#easy-footnote-bottom-11-654' title='One can build varying slope models with a fixed intercept, but we will not approach that horror here.'><sup>11</sup></a></span>.</p>
<p>With both the intercept and slope of the underlying linear predictor varying, an additional complexity raises its head: can we safely assume that these parameters, the intercept and slope, vary independently of each other, or may there be arcane correlations between them? Do states with a higher intercept also experience a higher slope in general, or is the opposite the case? Without prior knowledge to the contrary, we must allow our model to determine these possible correlations, or we are needlessly throwing away potential information in our model.</p>
<p>For a varying slope and intercept model, therefore, we must now include a <em>correlation matrix</em>, &#92;(\Omega&#92;), between the parameters of the linear predictor for each state in our model. This correlation matrix, as with all parameters in a Bayesian framework, must be expressed with a prior distribution from which the model can begin its evaluation of the data.</p>
<p>With deference to the authoritative <a href="https://mc-stan.org/docs/2_18/stan-users-guide/">quaint and curious volume of forgotten lore</a> we will use an <a href="https://mc-stan.org/docs/2_18/stan-users-guide/multivariate-hierarchical-priors-section.html">LKJ prior</a> for the correlation matrix without further discussion of the reasoning behind it.</p>
<p>$$\begin{eqnarray}<br />
y &amp;\sim&amp; \mathbf{NegBinomial}(\mu, \phi)&#92;&#92;<br />
\log(\mu) &amp;=&amp; \alpha_i + \beta x_i&#92;&#92;<br />
\begin{bmatrix}<br />
\alpha_i&#92;&#92;<br />
\beta_i<br />
\end{bmatrix} &amp;\sim&amp; \mathcal{N}(<br />
\begin{bmatrix}<br />
\mu_\alpha&#92;&#92;<br />
\mu_\beta<br />
\end{bmatrix}, \Omega )&#92;&#92;<br />
\Omega &amp;\sim&amp; \mathbf{LKJCorr}(2)&#92;&#92;<br />
\phi &amp;\sim&amp; \mathbf{HalfCauchy}(2)<br />
\end{eqnarray}$$</p>
<p>This model has grown and gained a somewhat twisted complexity compared with the serene austerity of our earliest linear model. Despite this, each further step in the descent has followed its own perverse logic, and the progression should clear. The corresponding Stan code follows:</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show negative binomial varying intercept and slope model specification code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>population_model_negbinomial_var_intercept_slope.stan</code><br />
[code]
<p>data {</p>
<p>	// Number of rows (observations)<br />
	int&lt;lower=1&gt; observations;</p>
<p>	// Number of states<br />
	int&lt; lower=0 &gt; states;</p>
<p>	// Vector detailing the US state in which each observation (count of<br />
	// counts in a year) occurred<br />
	int&lt; lower=1, upper=states &gt; state[ observations ];</p>
<p>	// Predictor (population of state)<br />
	vector[ observations ] population_raw;</p>
<p>	// Response (counts)<br />
	int&lt;lower=0&gt; counts[ observations ];</p>
<p>}</p>
<p>transformed data {</p>
<p>	// Center and scale the predictor<br />
	vector[ observations ] population;<br />
	population = ( population_raw &#8211; mean( population_raw ) ) / sd( population_raw );</p>
<p>}</p>
<p>parameters {</p>
<p>	// Per-state intercepts and slopes<br />
	vector[ states ] state_intercept;<br />
	vector[ states ] state_slope;</p>
<p>	// Baseline intercept and slope from which each group deviates.<br />
	real pop_intercept;<br />
	real pop_slope;</p>
<p>	// Per-state standard deviations for intercept and slope<br />
	vector&lt; lower=0 &gt;[2] state_sigma;</p>
<p>	// Negative binomial dispersion parameter<br />
	real&lt; lower=0 &gt; phi;</p>
<p>	// Parameter correlation matrix<br />
	corr_matrix[2] omega;</p>
<p>}</p>
<p>transformed parameters {</p>
<p>	vector[2] vec_intercept_slope[ states ];<br />
	vector[2] mu_intercept_slope;</p>
<p>	// Location parameter<br />
	vector[observations] eta;</p>
<p>	// Per-state intercepts and slopes<br />
	for( i in 1:states ) {</p>
<p>		vec_intercept_slope[ i, 1] = state_intercept[i];<br />
		vec_intercept_slope[ i, 2] = state_slope[i];</p>
<p>	}</p>
<p>	// Population slope and intercept<br />
	mu_intercept_slope[1] = pop_intercept;<br />
	mu_intercept_slope[2] = pop_slope;</p>
<p>	// Calculation negbinomial location parameter<br />
	for( i in 1:observations ) {<br />
		eta[i] = state_intercept[ state[i] ] + state_slope[ state[i]] * population[ i ];<br />
	}</p>
<p>}</p>
<p>model {</p>
<p>	// Priors<br />
	omega ~ lkj_corr(2);<br />
	phi ~ cauchy(0, 3 );<br />
	state_sigma ~ cauchy( 0, 3 );</p>
<p>	pop_intercept ~ normal( 0, 1 );<br />
	pop_slope ~ normal( 0, 1 );</p>
<p>	vec_intercept_slope ~ multi_normal( mu_intercept_slope, quad_form_diag( omega, state_sigma ) );</p>
<p>	// Model<br />
	counts ~ neg_binomial_2_log( eta, phi );</p>
<p>}</p>
<p>generated quantities {</p>
<p>	vector[observations] counts_pred;<br />
	vector[observations] log_lik;</p>
<p>	for (n in 1:observations) {</p>
<p>		log_lik[n] = neg_binomial_2_log_lpmf( counts[n] | eta[n], phi );<br />
		counts_pred[n] = neg_binomial_2_log_rng( eta[n], phi );</p>
<p>	}</p>
<p>}</p>
[/code]
</div></div>
</div>
<p>The ultimate test of our faith, then, is whether the added complexity of the partially-pooled varying slope, varying intercept model is justified. Once again, we turn to the ruthless judgement of the LOO-CV:</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show LOO-CV comparison code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
Code snippet for calculating the LOO-CV <code>elpd</code>. The full R code for building and comparing all models in this post is listed at the end.</p>
[code language=&#8221;R&#8221;]
&#8230;<br />
log_lik_negbinom_var_intercept_slope &lt;- extract_log_lik(fit_ufo_pop_negbinom_var_intercept_slope, merge_chains = FALSE)<br />
r_eff_negbinom_var_intercept_slope &lt;- relative_eff(exp(log_lik_negbinom_var_intercept_slope))<br />
loo_negbinom_var_intercept_slope &lt;- loo(log_lik_negbinom_var_intercept_slope, r_eff = r_eff_negbinom_var_intercept_slope, cores = 2)<br />
&#8230;<br />
[/code]
</div></div>
</div>
<pre class="brush: plain; title: ; notranslate">
&gt; compare( loo_negbinom_var_intercept, loo_negbinom_var_intercept_slope )
elpd_diff        se 
     13.3       2.4 
</pre>
<p>In this final step we can see that our labours in the arcane have been rewarded. The final model is once again a significant improvement over its simpler relatives. Whilst the potential for deeper and more perfect models never ends, we will settle for now on this.</p>
<h1>Mortal Consequences</h1>
<p>With our final model built, we can now begin to examine its mortifying implications. We will leave the majority of the subjective analysis for the next, and final, post in this series. For now, however, we can reinforce our quantitative analysis with visual assessment of the posterior predictive distribution output of our final model.</p>
<figure id="attachment_701" aria-describedby="caption-attachment-701" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive.png"><img loading="lazy" decoding="async" data-attachment-id="701" data-permalink="https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/posterior_predictive-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="bvi03-posterior_predictive" data-image-description="" data-image-caption="&lt;p&gt;Posterior predictive density plot of varying intercept, varying slope negative binomial model of UFO sightings.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive.png" alt="" width="1920" height="1080" class="size-full wp-image-701" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-701" class="wp-caption-text">Posterior predictive density plot of varying intercept, varying slope negative binomial GLM of UFO sightings. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/posterior_predictive.pdf">PDF Version</a>)</figcaption></figure>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show posterior predictive plotting code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>bayes_plots.r</code><br />
(Includes code to generate traceplot and posterior predictive distribution plot.)<br />
[code language=&#8221;R&#8221;]
<p>library( tidyverse )<br />
library( magrittr )<br />
library( lubridate )</p>
<p>library( ggplot2 )<br />
library( showtext )<br />
library( cowplot )</p>
<p>library( rstan )<br />
library( bayesplot )<br />
library( tidybayes )</p>
<p># Load UFO data<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p># UFO reporting font<br />
font_add( &quot;main_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
showtext_auto()</p>
<p># Plots, posterior predictive checking, LOO. </p>
<p># (Visualisations only produced for varying slope/intercept model, as a result<br />
# of LOO checking.</p>
<p># Bayesplot needs to be told which theme to use as a default.<br />
theme_set( theme_weird() )</p>
<p># Read the fitted model<br />
fit_ufo_pop_negbinom_var_intercept_slope &lt;-<br />
	readRDS( &quot;work/fit_ufo_pop_negbinom_var_intercept_slope.rds&quot; )</p>
<p>## Model checking visualisations</p>
<p># Extract posterior estimates from the fit (from the generated quantities of the stan model)<br />
counts_pred_negbinom_var_intercept_slope &lt;- as.matrix( fit_ufo_pop_negbinom_var_intercept_slope, pars = &quot;counts_pred&quot; )</p>
<p># First, as always, a traceplot<br />
tp &lt;-<br />
	traceplot(<br />
				 fit_ufo_pop_negbinom_var_intercept_slope,<br />
				 pars = c(&quot;pop_intercept&quot;, &quot;pop_slope&quot;, &quot;phi&quot; ),<br />
				 ncol=1 ) +<br />
	scale_colour_viridis_d( name=&quot;Chain&quot;, direction=-1 ) +<br />
	theme_weird()</p>
<p>title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;Traceplot of Key Parameters&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.40) </p>
<p>titled_tp &lt;-<br />
	plot_grid(title, tp, ncol=1, rel_heights=c(0.1, 1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/traceplot.pdf&quot;,<br />
			 titled_tp,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )</p>
<p># Posterior predictive density. (Visual representation of goodness of fit.)<br />
gp_ppc &lt;-<br />
	ppc_dens_overlay(<br />
						  y = extract2( ufo_population_sightings, &quot;count&quot; ),<br />
						  yrep = counts_pred_negbinom_var_intercept_slope  ) +<br />
	theme_weird()</p>
<p>title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;Posterior Predictive Density Plot&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.40) </p>
<p>titled_gp_ppc &lt;-<br />
	plot_grid(title, gp_ppc, ncol=1, rel_heights=c(0.1, 1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/posterior_predictive.pdf&quot;,<br />
			 titled_gp_ppc,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )</p>
[/code]
</div></div>
</div>
<p>In comparison with earlier attempts, the varying intercept and slope model visibly captures the overall shape of the distribution with terrifying ease. As our wary confidence mounts in the mindless automaton we have fashioned, we can now examine its predictive ability on our original data.</p>
<figure id="attachment_703" aria-describedby="caption-attachment-703" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.png"><img loading="lazy" decoding="async" data-attachment-id="703" data-permalink="https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/predictive_plot-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="bvi03-predictive_plot" data-image-description="" data-image-caption="&lt;p&gt;Varying intercept and slope negative binomial GLM of UFO sightings against population.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.png" alt="" width="1920" height="1080" class="size-full wp-image-703" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-703" class="wp-caption-text">Varying intercept and slope negative binomial GLM of UFO sightings against population. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/predictive_plot.pdf">PDF Version</a>)</figcaption></figure>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show negative binomial varying intercept and slope plot code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>population_plot.r</code><br />
[code]
<p>library( tidyverse )<br />
library( magrittr )<br />
library( lubridate )</p>
<p>library( ggplot2 )<br />
library( showtext )<br />
library( cowplot )</p>
<p>library( rstan )<br />
library( bayesplot )<br />
library( tidybayes )<br />
library( modelr )</p>
<p># Load UFO data and model<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p>fit_ufo_pop_negbinom_var_intercept_slope &lt;-<br />
	readRDS(&quot;work/fit_ufo_pop_negbinom_var_intercept_slope.rds&quot;)<br />
	#readRDS(&quot;work/fit_ufo_pop_normal_var_intercept_slope.rds&quot;)</p>
<p># UFO reporting font<br />
font_add( &quot;main_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
showtext_auto()</p>
<p># Plots, posterior predictive checking, LOO<br />
theme_set( theme_weird() )</p>
<p>## Model checking visualisations</p>
<p># Extract posterior estimates from the fit (from the generated quantities of the stan model)<br />
counts_pred_negbinom_var_intercept_slope &lt;- as.matrix( fit_ufo_pop_negbinom_var_intercept_slope, pars = &quot;counts_pred&quot; )</p>
<p>## Create per-state predictive fit plots</p>
<p># Convert fitted model (stanfit) object to a tibble<br />
fit_tbl &lt;-<br />
	summary(fit_ufo_pop_negbinom_var_intercept_slope)$summary %&gt;%<br />
	as.data.frame() %&gt;%<br />
	mutate(variable = rownames(.)) %&gt;%<br />
	select(variable, everything()) %&gt;%<br />
	as_tibble()</p>
<p>counts_predicted &lt;-<br />
	fit_tbl %&gt;%<br />
	filter( str_detect(variable,&#8217;counts_pred&#8217;) ) </p>
<p>ufo_population_sightings_pred &lt;-<br />
	ufo_population_sightings %&gt;%<br />
	ungroup() %&gt;%<br />
	mutate( count_mean = counts_predicted$mean,<br />
			 lower = counts_predicted$`25%`,<br />
			 upper = counts_predicted$`75%`) </p>
<p># (Using mean and SD of fit summary)<br />
predictive_plot &lt;-<br />
	ggplot( ufo_population_sightings_pred ) +<br />
	geom_point( aes( x=population, y=count, colour=state ), size=0.6, alpha=0.8 ) +<br />
	geom_line(aes( x=population, y=count_mean, colour=state )) +<br />
	geom_ribbon(aes(x=population, ymin = lower, ymax = upper, fill=state), alpha = 0.25) +<br />
	labs( x=&quot;Population (Thousands)&quot;, y=&quot;Annual Sightings&quot; ) +<br />
	scale_fill_viridis_d( name=&quot;State&quot; ) +<br />
	scale_colour_viridis_d( name=&quot;State&quot; ) +<br />
	theme(<br />
			axis.title.y = element_text( angle=90 ),<br />
			legend.position = &quot;none&quot; )</p>
<p># Construct full plot, with title and backdrop.<br />
title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;UFO Sightings against State Population (1990-2014)&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;Negative Binomial Hierarchical GLM. Varying slope and intercept. 50% credible intervals.&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.48) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.16) </p>
<p>data_label &lt;- ggdraw() +<br />
	draw_label(&quot;Data: http://www.nuforc.org | Tool: http://www.mc-stan.org&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=1, x=0.98 ) </p>
<p>predictive_plot_titled &lt;-<br />
	plot_grid(title, predictive_plot, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/predictive_plot.pdf&quot;,<br />
			 predictive_plot_titled,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )</p>
[/code]
</div></div>
</div>
<p>The purpose of our endeavours is to show whether or not the frequency of extraterrestrial visitations is merely a sad reflection of the number of unsuspecting humans living in each state. After seemingly endless cryptic calculations, our statistical machinery implies that there are deeper mysteries here: allowing the relationship between sightings and the underlying linear predictors to vary by state more perfectly predicts the data. There are clearly other, hidden, factors in play.</p>
<p>More than that, however, our final model allows us to quantify these differences. We can now retrieve from the very bowels of our inferential process the per-state distribution of paremeters for both the slope and intercept of the linear predictor.</p>
<figure id="attachment_705" aria-describedby="caption-attachment-705" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.png"><img loading="lazy" decoding="async" data-attachment-id="705" data-permalink="https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/ufo_per-state_intercepts-slopes/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="ufo_per-state_intercepts-slopes" data-image-description="" data-image-caption="&lt;p&gt;Varying slope and intercept negative binomial GLM parameter plot.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.png" alt="" width="1920" height="1080" class="size-full wp-image-705" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-705" class="wp-caption-text">Varying slope and intercept negative binomial GLM parameter plot for UFO sightings model. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/ufo_per-state_intercepts-slopes.pdf">PDF Version</a>)</figcaption></figure>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show per-state intercept and slope plotting code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p><code>slope_intercept_plot.r</code><br />
[code language=&#8221;R&#8221;]
<p>library( tidyverse )<br />
library( magrittr )<br />
library( lubridate )</p>
<p>library( ggplot2 )<br />
library( showtext )<br />
library( cowplot )</p>
<p>library( rstan )<br />
library( bayesplot )<br />
library( tidybayes )<br />
library( modelr )</p>
<p># Load UFO data and model<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p>fit_ufo_pop_negbinom_var_intercept_slope &lt;-<br />
	readRDS(&quot;work/fit_ufo_pop_negbinom_var_intercept_slope.rds&quot;)<br />
	#readRDS(&quot;work/fit_ufo_pop_normal_var_intercept_slope.rds&quot;)</p>
<p># UFO reporting font<br />
font_add( &quot;main_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
showtext_auto()</p>
<p># Plots, posterior predictive checking, LOO<br />
theme_set( theme_weird() )</p>
<p># Use teal colour scheme<br />
color_scheme_set( &quot;teal&quot;)</p>
<p>## Model checking visualisations</p>
<p># Extract posterior estimates from the fit (from the generated quantities of the stan model)<br />
counts_pred_negbinom_var_intercept_slope &lt;- as.matrix( fit_ufo_pop_negbinom_var_intercept_slope, pars = &quot;counts_pred&quot; )</p>
<p># US state data<br />
us_state_factors &lt;-<br />
	levels( factor( ufo_population_sightings$state ) )</p>
<p># US state names for nice plotting<br />
# Data: &lt;https://www.50states.com/abbreviations.htm&gt;<br />
state_code_data &lt;-<br />
	read_csv( file=&quot;data/us_states.csv&quot; ) %&gt;%<br />
	filter( code %in% us_state_factors ) </p>
<p># Rename variables back to state names<br />
posterior_intercepts &lt;-<br />
	as.data.frame( fit_ufo_pop_negbinom_var_intercept_slope ) %&gt;%<br />
	as_tibble %&gt;%<br />
	select(starts_with(&#8216;state_intercept&#8217;) ) %&gt;%<br />
	rename_all( ~us_state_factors ) %&gt;%<br />
	rename_all( ~extract2( state_code_data, &quot;us_state&quot; ) )</p>
<p># Rename variables back to state names<br />
posterior_slopes &lt;-<br />
	as.data.frame( fit_ufo_pop_negbinom_var_intercept_slope ) %&gt;%<br />
	as_tibble %&gt;%<br />
	select(starts_with(&#8216;state_slope&#8217;) ) %&gt;%<br />
	rename_all( ~us_state_factors ) %&gt;%<br />
	rename_all( ~extract2( state_code_data, &quot;us_state&quot; ) )</p>
<p># Posterior draws combined<br />
posterior_slopes_long &lt;-<br />
	posterior_slopes %&gt;%<br />
	gather( value = &quot;slope&quot; )</p>
<p>posterior_intercepts_long &lt;-<br />
	posterior_intercepts %&gt;%<br />
	gather( value = &quot;intercept&quot; )</p>
<p>posterior_draws_long &lt;-<br />
	bind_cols( posterior_intercepts_long, posterior_slopes_long ) %&gt;%<br />
	select( -key1 ) %&gt;%<br />
	transmute( state = key, intercept, slope )</p>
<p># Interval plots (slope and intervals)<br />
# Plot intercept parameters for varying intercept and slope model<br />
gp_intercept &lt;-<br />
	mcmc_intervals( posterior_intercepts ) +<br />
	ggtitle( &quot;Intercepts&quot; ) +<br />
	theme_weird() </p>
<p># Plot slope parameters for varying intercept and slope model<br />
# (Remove y-axis labels as this will be aligned with the intercept plot.)<br />
gp_slope &lt;-<br />
	mcmc_intervals( posterior_slopes ) +<br />
	ggtitle( &quot;Slopes&quot; ) +<br />
	theme_weird() +<br />
	theme(<br />
			axis.text.y = element_blank()<br />
			)</p>
<p>gp_slope_intercept &lt;-<br />
	plot_grid( gp_intercept, gp_slope, ncol=2 )</p>
<p># Construct full plot, with title and backdrop.<br />
title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;Per-State UFO Intercepts and Slopes&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;Mean value, 50% credible interval, and 95% credible interval shown.&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.48) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.16) </p>
<p>data_label &lt;- ggdraw() +<br />
	draw_label(&quot;Data: http://www.nuforc.org | Tool: http://www.mc-stan.org&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=1, x=0.98 ) </p>
<p>data_label &lt;- ggdraw() +<br />
	draw_label(&quot;Data: http://www.nuforc.org | Tool: http://www.mc-stan.org&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=1, x=0.98 ) </p>
<p>data_label &lt;- ggdraw() +<br />
	draw_label(&quot;Data: http://www.nuforc.org | Tool: http://www.mc-stan.org&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=1, x=0.98 ) </p>
<p>gp_slope_intercept_titled &lt;-<br />
	plot_grid(title, gp_slope_intercept, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1)) +<br />
	theme( panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;)) </p>
<p>save_plot(&quot;output/ufo_per-state_intercepts-slopes.pdf&quot;,<br />
			 gp_slope_intercept_titled,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )</p>
[/code]
</div></div>
</div>
<p>It is important to note that, while we are still referring to the &#92;(\alpha&#92;) and &#92;(\beta&#92;) parameters as the slope and intercept, their interpretation is more complex in a generalised linear model with a &#92;(\log&#92;) link function than in the simple linear model. For now, however, this diagram is sufficient to show that the horror visited on innocent lives by our interstellar visitors is not purely arbitrary, but depends at least in part on geographical location.</p>
<p>With this malign inferential process finally complete we will turn, in the next post, to a trembling interpretation of the model and its dark implications for our collective future.</p>
<h2>Model Fitting and Comparison Code Listing</h2>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show full model fitting and LOO-CV comparison code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p>This code fits the range of models developed in this series, relying on the individual Stan source code files, and runs the LOO-CV comparisons discussed in this post.</p>
<p><code>population_model.r</code><br />
[code]
library( tidyverse )<br />
library( magrittr )</p>
<p>library( ggplot2 )<br />
library( showtext )</p>
<p>library( rstan )<br />
library( tidybayes )<br />
library( loo )</p>
<p># Load UFO data<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p>## Simple Models<br />
## Complete Pooling &#8212; all states considered identical. </p>
<p># Fit model of UFO sightings (Normal)<br />
if( not( file.exists( &quot;work/fit_ufo_pop_normal.rds&quot; ) ) ) {</p>
<p>	message(&quot;Fitting basic Normal model.&quot;)</p>
<p>	fit_ufo_pop_normal &lt;-<br />
		stan( file=&quot;model/population_model_normal.stan&quot;,<br />
			  data=list(<br />
							observations = nrow( ufo_population_sightings ),<br />
							population = extract2( ufo_population_sightings, &quot;population&quot; ),<br />
							counts = extract2( ufo_population_sightings, &quot;count&quot; )<br />
			  )<br />
		)</p>
<p>	saveRDS( fit_ufo_pop_normal, &quot;work/fit_ufo_pop_normal.rds&quot; )</p>
<p>	message(&quot;Basic Normal model fitted.&quot;)</p>
<p>} else {</p>
<p>	fit_ufo_pop_normal &lt;- readRDS( &quot;work/fit_ufo_pop_normal.rds&quot; )</p>
<p>}</p>
<p># Fit model of UFO sightings (Poisson)<br />
if( not( file.exists( &quot;work/fit_ufo_pop_poisson.rds&quot; ) ) ) {</p>
<p>	message(&quot;Fitting basic Poisson model.&quot;)</p>
<p>	fit_ufo_pop_poisson &lt;-<br />
		stan( file=&quot;model/population_model_poisson.stan&quot;,<br />
			  data=list(<br />
							observations = nrow( ufo_population_sightings ),<br />
							population_raw = extract2( ufo_population_sightings, &quot;population&quot; ),<br />
							counts = extract2( ufo_population_sightings, &quot;count&quot; )<br />
			  )<br />
		)</p>
<p>	saveRDS( fit_ufo_pop_poisson, &quot;work/fit_ufo_pop_poisson.rds&quot; )</p>
<p>	message(&quot;Basic Poisson model fitted.&quot;)</p>
<p>} else {</p>
<p>	fit_ufo_pop_poisson &lt;- readRDS( &quot;work/fit_ufo_pop_poisson.rds&quot; )</p>
<p>}</p>
<p># Fit model of UFO sightings (Negative Binomial)<br />
if( not( file.exists( &quot;work/fit_ufo_pop_negbinom.rds&quot; ) ) ) {</p>
<p>	message(&quot;Fitting basic negative binomial model.&quot;)</p>
<p>	fit_ufo_pop_negbinom &lt;-<br />
		stan( file=&quot;model/population_model_negbinomial.stan&quot;,<br />
			  data=list(<br />
							observations = nrow( ufo_population_sightings ),<br />
							population_raw = extract2( ufo_population_sightings, &quot;population&quot; ),<br />
							counts = extract2( ufo_population_sightings, &quot;count&quot; ) )<br />
		)</p>
<p>	saveRDS( fit_ufo_pop_negbinom, &quot;work/fit_ufo_pop_negbinom.rds&quot; )</p>
<p>	message(&quot;Basic negative binomial model fitted.&quot;)</p>
<p>} else {</p>
<p>	fit_ufo_pop_negbinom &lt;- readRDS( &quot;work/fit_ufo_pop_negbinom.rds&quot; )</p>
<p>}</p>
<p>## Multilevel Models<br />
## Partial Pooling (Varying Intercept)</p>
<p>if( not( file.exists( &quot;work/fit_ufo_pop_negbinom_var_intercept.rds&quot; ) ) ) {</p>
<p>	message(&quot;Fitting varying intercept negative binomial model.&quot;)</p>
<p>	fit_ufo_pop_negbinom_var_intercept &lt;-<br />
		stan( file=&quot;model/population_model_negbinomial_var_intercept.stan&quot;,<br />
			  data=list(<br />
							observations = nrow( ufo_population_sightings ),<br />
							population_raw = extract2( ufo_population_sightings, &quot;population&quot; ),<br />
							counts = extract2( ufo_population_sightings, &quot;count&quot; ),<br />
							states = length( unique( ufo_population_sightings$state ) ),<br />
							state = as.numeric( factor( ufo_population_sightings$state ) )<br />
							),<br />
			  chains=4, iter=2000,<br />
			  control = list(max_treedepth = 15, adapt_delta=0.9)<br />
		)</p>
<p>	saveRDS( fit_ufo_pop_negbinom_var_intercept, &quot;work/fit_ufo_pop_negbinom_var_intercept.rds&quot; )</p>
<p>	message(&quot;Varying intercept negative binomial model fitted.&quot;)</p>
<p>} else {</p>
<p>	fit_ufo_pop_negbinom_var_intercept &lt;- readRDS( &quot;work/fit_ufo_pop_negbinom_var_intercept.rds&quot; )</p>
<p>}</p>
<p>### Partial Pooling (Varying intercept and slope.)</p>
<p>if( not( file.exists( &quot;work/fit_ufo_pop_negbinom_var_intercept_slope.rds&quot; ) ) ) {</p>
<p>	message(&quot;Fitting varying intercept and slope negative binomial model&quot;)</p>
<p>	fit_ufo_pop_negbinom_var_intercept_slope &lt;-<br />
		stan( file=&quot;model/population_model_negbinomial_var_intercept_slope.stan&quot;,<br />
			  data=list(<br />
							observations = nrow( ufo_population_sightings ),<br />
							population_raw = extract2( ufo_population_sightings, &quot;population&quot; ),<br />
							counts = extract2( ufo_population_sightings, &quot;count&quot; ),<br />
							states = length( unique( ufo_population_sightings$state ) ),<br />
							state = as.numeric( factor( ufo_population_sightings$state ) )<br />
							),<br />
			  chains=4, iter=2000,<br />
			  control = list(max_treedepth = 12, adapt_delta=0.8)<br />
		)</p>
<p>	saveRDS( fit_ufo_pop_negbinom_var_intercept_slope, &quot;work/fit_ufo_pop_negbinom_var_intercept_slope.rds&quot; )</p>
<p>	message(&quot;Varying intercept and slope negative binomial model fitted.&quot;)</p>
<p>} else {</p>
<p>	fit_ufo_pop_negbinom_var_intercept_slope &lt;- readRDS( &quot;work/fit_ufo_pop_negbinom_var_intercept_slope.rds&quot; )</p>
<p>}</p>
<p># Hierarchical normal. (Linear regression)<br />
if( not( file.exists( &quot;work/fit_ufo_pop_normal_var_intercept_slope.rds&quot; ) ) ) {</p>
<p>	message(&quot;Fitting varying intercept and slope normal model&quot;)</p>
<p>	fit_ufo_pop_normal_var_intercept_slope &lt;-<br />
		stan( file=&quot;model/population_model_normal_var_intercept_slope.stan&quot;,<br />
			  data=list(<br />
							observations = nrow( ufo_population_sightings ),<br />
							population_raw = extract2( ufo_population_sightings, &quot;population&quot; ),<br />
							counts = extract2( ufo_population_sightings, &quot;count&quot; ),<br />
							states = length( unique( ufo_population_sightings$state ) ),<br />
							state = as.numeric( factor( ufo_population_sightings$state ) )<br />
							),<br />
			  chains=4, iter=2000,<br />
			  control = list(max_treedepth = 15, adapt_delta=0.9)<br />
		)</p>
<p>	saveRDS( fit_ufo_pop_normal_var_intercept_slope, &quot;work/fit_ufo_pop_normal_var_intercept_slope.rds&quot; )</p>
<p>	message(&quot;Varying intercept and slope normal model fitted.&quot;)</p>
<p>} else {</p>
<p>	fit_ufo_pop_normal_var_intercept_slope &lt;- readRDS( &quot;work/fit_ufo_pop_normal_var_intercept_slope.rds&quot; )</p>
<p>}</p>
<p>## Notify by text<br />
message(&quot;All models fit.&quot;)</p>
<p># Compare models with LOO<br />
log_lik_normal &lt;- extract_log_lik(fit_ufo_pop_normal, merge_chains = FALSE)<br />
r_eff_normal &lt;- relative_eff(exp(log_lik_normal))<br />
loo_normal &lt;- loo(log_lik_normal, r_eff = r_eff_normal, cores = 2)</p>
<p>log_lik_poisson &lt;- extract_log_lik(fit_ufo_pop_poisson, merge_chains = FALSE)<br />
r_eff_poisson &lt;- relative_eff(exp(log_lik_poisson))<br />
loo_poisson &lt;- loo(log_lik_poisson, r_eff = r_eff_poisson, cores = 2)</p>
<p>log_lik_negbinom &lt;- extract_log_lik(fit_ufo_pop_negbinom, merge_chains = FALSE)<br />
r_eff_negbinom &lt;- relative_eff(exp(log_lik_negbinom))<br />
loo_negbinom &lt;- loo(log_lik_negbinom, r_eff = r_eff_negbinom, cores = 2)# Compare models with LOO</p>
<p>log_lik_negbinom_var_intercept &lt;- extract_log_lik(fit_ufo_pop_negbinom_var_intercept, merge_chains = FALSE)<br />
r_eff_negbinom_var_intercept &lt;- relative_eff(exp(log_lik_negbinom_var_intercept))<br />
loo_negbinom_var_intercept &lt;- loo(log_lik_negbinom_var_intercept, r_eff = r_eff_negbinom_var_intercept, save_psis = TRUE)</p>
<p>log_lik_negbinom_var_intercept_slope &lt;- extract_log_lik(fit_ufo_pop_negbinom_var_intercept_slope, merge_chains = FALSE)<br />
r_eff_negbinom_var_intercept_slope &lt;- relative_eff(exp(log_lik_negbinom_var_intercept_slope))<br />
loo_negbinom_var_intercept_slope &lt;- loo(log_lik_negbinom_var_intercept_slope, r_eff = r_eff_negbinom_var_intercept_slope, save_psis = TRUE)</p>
<p>normal_poisson_comparison &lt;- compare( loo_normal, loo_poisson )<br />
poiss_negbinom_comparison &lt;- compare( loo_poisson, loo_negbinom )<br />
negbinom_negbinom_var_intercept_comparison &lt;- compare( loo_negbinom, loo_negbinom_var_intercept )<br />
negbinom_var_intercept_negbinom_var_intercept_slope_comparison &lt;- compare( loo_negbinom_var_intercept, loo_negbinom_var_intercept_slope )</p>
<p>saveRDS( normal_poisson_comparison, &quot;work/normal_poisson_comparison.rds&quot; )<br />
saveRDS( poiss_negbinom_comparison, &quot;work/poiss_negbinom_comparison.rds&quot; )<br />
saveRDS( negbinom_negbinom_var_intercept_comparison, &quot;work/negbinom_negbinom_var_intercept_comparison.rds&quot; )<br />
saveRDS( negbinom_var_intercept_negbinom_var_intercept_slope_comparison, &quot;work/negbinom_var_intercept_negbinom_var_intercept_slope_comparison.rds&quot; )</p>
[/code]
</div></div>
</div>
<h2>Footnotes</h2>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2019/04/17/bayes-vs-the-invaders-part-three-the-parallax-view/feed/</wfw:commentRss>
			<slash:comments>4</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">654</post-id>	</item>
		<item>
		<title>Bayes vs. the Invaders! Part Two: Abnormal Distributions</title>
		<link>https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/</link>
					<comments>https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/#comments</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Mon, 08 Apr 2019 14:48:58 +0000</pubDate>
				<category><![CDATA[beyond the veil]]></category>
		<category><![CDATA[stan]]></category>
		<category><![CDATA[ufo]]></category>
		<guid isPermaLink="false">http://www.weirddatascience.net/?p=559</guid>

					<description><![CDATA[<div class="mh-excerpt">This post continues our series on developing statistical models to explore the arcane relationship between UFO sightings and population. The simple linear model developed in the previous post is far from satisfying. It makes many unsupportable assumptions about the data and the form of the residual errors from the model. Most obviously, it relies on an underlying Gaussian (or _normal_) distribution for its understanding of the data. For our count data, some basic features of the Guassian are inappropriate. </div> <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/" title="Bayes vs. the Invaders! Part Two: Abnormal Distributions">[...]</a>]]></description>
										<content:encoded><![CDATA[<h1>Crossing the Line</h1>
<p>This post continues our series on developing statistical models to explore the arcane relationship between UFO sightings and population. The previous post is available here: <a href="http://www.weirddatascience.net/index.php/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/">Bayes vs. the Invaders! Part One: The 37th Parallel</a>.</p>
<p>The simple linear model developed in the previous post is far from satisfying. It makes many unsupportable assumptions about the data and the form of the residual errors from the model. Most obviously, it relies on an underlying Gaussian (or <em>normal</em>) distribution for its understanding of the data. For our count data, some basic features of the Guassian are inappropriate.</p>
<p>Most notably:</p>
<ul>
<li> a Gaussian distribution is <a href="https://en.wikipedia.org/wiki/Probability_distribution#Continuous_probability_distribution">continuous</a> whilst counts are <a href="https://en.wikipedia.org/wiki/Probability_distribution#Discrete_probability_distribution">discrete</a> &#8212; you can&#8217;t have 2.3 UFO sightings in a given day;</li>
<li> the Gaussian can produce negative values, which are impossible when dealing with counts &#8212; you can&#8217;t have a negative number of UFO sightings;</li>
<li> the Gaussian is symmetrical around its mean value whereas count data is typically <em>skewed</em>.</li>
</ul>
<p>Moving from the safety and comfort of basic <em>linear regression</em>, then, we will delve into the madness and chaos of <em>generalized linear models</em> that allow us to choose from a range of distributions to describe the relationship between state population and counts of UFO sightings.</p>
<h1>Basic Models</h1>
<p>We will be working in a <a href="https://en.wikipedia.org/wiki/Bayesian_inference">Bayesian</a> framework, in which we assign a <em>prior distribution</em> to each parameter that allows, and requires, us to express some <em>prior knowledge</em> about the parameters of interest. These priors are the initial starting points for parameters Afrom which the model moves towards the underlying values as it learns from the data. Choice of priors can have significant effects not only on the outputs of the model, but also its ability to function effectively; as such, it is both an important, but also arcane and subtle, aspect of the Bayesian approach<span id='easy-footnote-12-559' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/#easy-footnote-bottom-12-559' title='This is not a full, or even partially adequate, description of the Bayesian approach to statistical inference, and as such we will skip over a number of very significant details. This includes full discussion of the Bayesian approach, the difference between informative and uninformative priors, and the reasoning behind many of the choices made with respect to priors. An excellent, hugely engaging, and practical textbook for indoctrination into the cult of Bayesian inference is &lt;a href=&quot;https://xcelab.net/rm/statistical-rethinking/&quot;&gt;Statistical Rethinking&lt;/a&gt; by Richard McElreath.'><sup>12</sup></a></span>.</p>
<p>Practically speaking, a simple linear regression can be expressed in the following form:<br />

$$y \sim \mathcal{N}(\mu, \sigma)$$</p>
<p>(Read as &#8220;&#92;(y&#92;) <em>is drawn from</em> a normal distribution with mean &#92;(\mu&#92;) and standard deviation &#92;(\sigma&#92;)&#8221;).</p>
<p>In the the above expression the model relies on a Gaussian, or <em>normal</em> <em>likelihood</em> (&#92;(\mathcal{N}&#92;)) to describe the data &#8212; making assertions regarding how we believe the underlying data was generated. The Gaussian distribution is parameterised by a <em>location parameter</em> (&#92;(\mu&#92;)) and a standard deviation (&#92;(\sigma&#92;)).</p>
<p>If we were uninterested in prediction, we could describe the <em>shape</em> of the distribution of counts (&#92;(y&#92;)) without a predictor variable. In this approach, we could specify our model by providing <em>priors</em> for &#92;(\mu&#92;) and &#92;(\sigma&#92;) that express a level of belief in their likely values:</p>
<p>$$\begin{eqnarray}<br />
y &amp;\sim&amp; \mathcal{N}(\mu, \sigma) &#92;&#92;<br />
\mu &amp;\sim&amp; \mathcal{N}(0, 1) &#92;&#92;<br />
\sigma &amp;\sim&amp; \mathbf{HalfCauchy}(2)<br />
\end{eqnarray}$$</p>
<p>This provides an initial belief as to the likely shape of the data that informs, via arcane computational procedures, the model of how the observed data approaches the underlying truth<span id='easy-footnote-13-559' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/#easy-footnote-bottom-13-559' title='For practical reasons related to efficient computation and numerical stability, it is common practice to &lt;em&gt;standardize&lt;/em&gt; the input data by centering and scaling it so that the mean value of the data is 0 and the variance is 1. Rather than being simply a convenience, this practice can have significant effects on both the speed and stability of models, and is highly recommended unless there is a good reason to avoid it.'><sup>13</sup></a></span>.</p>
<p>This model is less than interesting, however. It simply defines a range of possible Gaussian distributions without unveiling the horror of the underlying relationships between unsuspecting terrestrial inhabitants and anomalous events.</p>
<p>To construct such a model, relating a <em>predictor</em> to a <em>response</em>, we express those relationships as follows:</p>
<p>$$\begin{eqnarray}<br />
y &amp;\sim&amp; \mathcal{N}(\mu, \sigma) &#92;&#92;<br />
\mu &amp;=&amp; \alpha + \beta x &#92;&#92;<br />
\alpha &amp;\sim&amp; \mathcal{N}(0, 1) &#92;&#92;<br />
\beta &amp;\sim&amp; \mathcal{N}(0, 1) &#92;&#92;<br />
\sigma &amp;\sim&amp; \mathbf{HalfCauchy}(1)<br />
\end{eqnarray}$$</p>
<p>In this model, the parameters of the likelihood are now probability distributions themselves. From a traditional linear model, we now have an <em>intercept</em> (&#92;(\alpha&#92;)), and a <em>slope</em> (&#92;(\beta&#92;)) that relates the change in the predictor variable (&#92;(x&#92;)) to the change in the response. Each of these <a href="https://en.wikipedia.org/wiki/Hyperparameter"><em>hyperparameters</em></a> is fitted according to the observed dataset.</p>
<h1>A New Model</h1>
<p>We can now break free from the bonds of pure linear regression and consider other distributions that more naturally describe data of the form that we are considering. The awful power of GLMs is that they can use an underlying linear model, such &#92;(\alpha + \beta x&#92;), as parameters to a range of likelihoods beyond the Gaussian. This allows the natural description of a vast and esoteric menagerie of possible data.</p>
<p>The second key element of a generalised linear model is the <em>link function</em> that transforms the relationship between the parameters and the data into a form suitable for our twisted calculations. We can consider the link function as acting on the linear predictor &#8212; such as &#92;(\alpha + \beta x&#92;) in our example model &#8212; to represent a different relationship via a range of possible functions, many of which are inextricably bound to certain likelihood functions.</p>
<p>For count data the most commonly-chosen likelihood is the <a href="https://en.wikipedia.org/wiki/Poisson_distribution">Poisson</a> distribution, whose sole parameter is the <em>arrival rate</em> (&#92;(\lambda&#92;)). While somewhat restricted, as we will see, we can begin our descent into madness by fitting a Poisson-based model to our observed data. For Poisson-based generalised linear models, the canonical link function is the <em>log</em> &#8212;  our linear predictor, rather than directly being the parameter &#92;(\lambda&#92;) is instead the <em>logarithm</em> of &#92;(\lambda&#92;). The insidious effects of this on the output of the model will become all too obvious as we persist.</p>
<h1>Stan</h1>
<p>To fit a model, we will use the <a href="http://mc-stan.org">Stan</a> probabilistic programming language. Stan allows us to write a program defining a stastical model which can then be fit to the data using <a href="https://en.wikipedia.org/wiki/Markov_chain_Monte_Carlo">Markov-Chain Monte Carlo</a> (MCMC) methods. In effect, at a very abstract level, this approach uses a random sampling to discover the values of the parameters that best fit the observed data<span id='easy-footnote-14-559' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/#easy-footnote-bottom-14-559' title='For a fuller explanation of the concepts behind this approach, the &lt;a href=&quot;http://mc-stan.org&quot;&gt;Stan website&lt;/a&gt; and the book &lt;a href=&quot;https://xcelab.net/rm/statistical-rethinking/&quot;&gt;Statistical Rethinking&lt;/a&gt; are enormously valuable references. For the deepest descent into the occult mysteries, Gelman et al.&amp;#8217;s &lt;a href=&quot;http://www.stat.columbia.edu/~gelman/book/&quot;&gt;Bayesian Data Analysis&lt;/a&gt; is &lt;a href=&quot;http://www.hplovecraft.com/writings/texts/fiction/dh.aspx&quot;&gt;the key and the guardian of the gate&lt;/a&gt;.'><sup>14</sup></a></span>.</p>
<p>Stan lets us specify models in the form given above, along with ways to pass in and define the nature and form of the data. This code can then be called from R using the <code>rstan</code> package.</p>
<p>In this, and subsequent posts, we will be using Stan code directly as both a learning and explanatory exercise. In typical usage, however it is often more convenient to use one of two excellent R packages <a href="https://github.com/paul-buerkner/brms"><code>brms</code></a> or <a href="https://github.com/stan-dev/rstanarm"><code>rstanarm</code></a> that allow for more compact and convenient specification of models, with well-specified raw Stan code generated automatically.</p>
<h1>De Profundis</h1>
<p>In seeking to take our first steps beyond the <a href="http://www.hplovecraft.com/writings/texts/fiction/cc.aspx">placid island of ignorance</a> of the Gaussian, the Poisson distribution is a first step for assessing count data. Adapting the Gaussian model above, we can propose a predictive model for the entire population of states as follows:</p>
<p>$$\begin{eqnarray}<br />
y &amp;\sim&amp; \mathbf{Poisson}(\lambda) &#92;&#92;<br />
\log( \lambda ) &amp;=&amp; \alpha + \beta x &#92;&#92;<br />
\alpha &amp;\sim&amp; \mathcal{N}(0, 1) &#92;&#92;<br />
\beta &amp;\sim&amp; \mathcal{N}(0, 1)<br />
\end{eqnarray}$$</p>
<p>The sole parameter of the Poisson is the <em>arrival rate</em> (&#92;(\lambda&#92;)) that we construct here from a population-wide intercept (&#92;(\alpha&#92;)) and slope (&#92;(\beta&#92;)). Note that, in contrast to earlier models, the linear predictor is subject to the &#92;(\log&#92;) <em>link function</em>.</p>
<p>The Stan code for the above model, and associated R code to run it, is below:</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show model specification and execution code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p>population_model_poisson.stan<br />
[code language=&#8221;c&#8221;]
<p>data {</p>
<p>	// Number of rows (observations)<br />
	int&lt;lower=1&gt; observations;</p>
<p>	// Predictor (population of state)<br />
	vector[ observations ] population_raw;</p>
<p>	// Response (counts)<br />
	int&lt;lower=0&gt; counts[observations];</p>
<p>}</p>
<p>transformed data {</p>
<p>	// Center and scale the predictor<br />
	vector[ observations ] population;<br />
	population = ( population_raw &#8211; mean( population_raw ) ) / sd( population_raw );</p>
<p>}</p>
<p>parameters {</p>
<p>	// Intercept<br />
	real&lt; lower=0 &gt; a;</p>
<p>	// Slope<br />
	real&lt; lower=0 &gt; b;</p>
<p>}</p>
<p>transformed parameters {</p>
<p>	vector&lt;lower=0&gt;[ observations ] mu;<br />
	mu = a + b * population;</p>
<p>}</p>
<p>model {</p>
<p>	// Priors<br />
	a ~ normal( 0, 1 );<br />
	b ~ normal( 0, 1 );</p>
<p>	// Model using the log-parameterised poisson<br />
	counts ~ poisson_log( mu );</p>
<p>}</p>
<p>generated quantities {</p>
<p>	// Posterior predictions<br />
	vector[observations] counts_pred;</p>
<p>	// Log likelihood (for LOO)<br />
	vector[observations] log_lik;</p>
<p>	for (n in 1:observations) {</p>
<p>		log_lik[n] = poisson_log_lpmf( counts[n] | mu[n] );<br />
		counts_pred[n] = poisson_log_rng( mu[n] );</p>
<p>	}</p>
<p>}</p>
[/code]
<p>population_model_poisson.r<br />
[code language=&#8221;r&#8221;]
library( tidyverse )<br />
library( magrittr )</p>
<p>library( ggplot2 )<br />
library( showtext )</p>
<p>library( rstan )<br />
library( tidybayes )<br />
library( loo )</p>
<p># Load UFO data<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p># Fit model of UFO sightings (Poisson)<br />
# As this is computationally expensive, the fitted model will be<br />
# saved to disk, and the process only run if the saved model file<br />
# does not already exist.<br />
if( not( file.exists( &quot;work/fit_ufo_pop_poisson.rds&quot; ) ) ) {</p>
<p>	message(&quot;Fitting basic Poisson model.&quot;)<br />
	sms_notify(&quot;Fitting basic Poisson model.&quot;)</p>
<p>	fit_ufo_pop_poisson &lt;-<br />
		stan( file=&quot;model/population_model_poisson.stan&quot;,<br />
			  data=list(<br />
							observations = nrow( ufo_population_sightings ),<br />
							population = extract2( ufo_population_sightings, &quot;population&quot; ),<br />
							counts = extract2( ufo_population_sightings, &quot;count&quot; )<br />
			  )<br />
		)</p>
<p>	saveRDS( fit_ufo_pop_poisson, &quot;work/fit_ufo_pop_poisson.rds&quot; )</p>
<p>	message(&quot;Basic Poisson model fitted.&quot;)</p>
<p>} else {</p>
<p>	fit_ufo_pop_poisson &lt;- readRDS( &quot;work/fit_ufo_pop_poisson.rds&quot; )</p>
<p>}<br />
[/code]
</div></div>
</div>
<p>With this model encoded and fit, we can now peel back the layers of the procedure to see the extent to which it has endured the horror of our data.</p>
<p>The MCMC algorithm that underpins Stan &#8212; specifically <a href="https://en.wikipedia.org/wiki/Hamiltonian_Monte_Carlo">Hamiltonian Monte Carlo</a> (HMC) using the <a href="http://www.stat.columbia.edu/~gelman/research/unpublished/nuts.pdf">No U-Turn Sampler</a> (NUTS) &#8212; attempts to find an island of stability in the space of possibilities that corresponds to the best fit to the observed data. To do so, the algorithm spawns a set of <a href="https://en.wikipedia.org/wiki/Markov_chain">Markov chains</a> that explore the parameter space. If the model is appropriate, and the data coherent, the set of Markov chains end up <em>converging</em> to exploring a similar, small set of possible states.</p>
<h1>Validation</h1>
<p>When modelling via this approach, a first check of the model&#8217;s chances of having fit correctly is to examine the so-called &#8216;traceplot&#8217; that shows how well the separate Markov chains &#8216;mix&#8217; &#8212; that is, converge to exploring the same area of the parameter space<span id='easy-footnote-15-559' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/#easy-footnote-bottom-15-559' title='&amp;#8220;&lt;a href=&quot;https://arxiv.org/abs/1709.01449&quot;&gt;Visualization in Bayesian workflow&lt;/a&gt;&amp;#8221; by Gabry et al. is an excellent reference for the visual aspects of this approach to model checking.'><sup>15</sup></a></span>. For the Poisson model above, the traceplot can be created using the <code>bayesplot</code> library:</p>
<figure id="attachment_612" aria-describedby="caption-attachment-612" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot.png"><img loading="lazy" decoding="async" data-attachment-id="612" data-permalink="https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/poisson_traceplot-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="bvi02-poisson_traceplot" data-image-description="" data-image-caption="&lt;p&gt;Traceplot of Markov chains from Poisson model fitting.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot.png" alt="Traceplot of Markov chains from Poisson model fitting." width="1920" height="1080" class="size-full wp-image-612" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-612" class="wp-caption-text">Traceplot of Markov chains from Poisson model fitting. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_traceplot.pdf">PDF Version</a>)</figcaption></figure>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show traceplot code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
[code language=&#8221;r&#8221;]
library( tidyverse )<br />
library( magrittr )<br />
library( lubridate )</p>
<p>library( ggplot2 )<br />
library( showtext )<br />
library( cowplot )</p>
<p>library( rstan )<br />
library( bayesplot )<br />
library( tidybayes )</p>
<p># Load UFO data<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p># UFO reporting font<br />
font_add( &quot;main_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
showtext_auto()</p>
<p># Bayesplot needs to be told which theme to use as a default.<br />
theme_set( theme_weird() )</p>
<p># Read the fitted model<br />
fit_ufo_pop_poisson &lt;- readRDS( &quot;work/fit_ufo_pop_poisson.rds&quot; )</p>
<p># First, as always, a traceplot<br />
tp &lt;-<br />
	traceplot(<br />
				 fit_ufo_pop_poisson,<br />
				 pars = c(&quot;a&quot;, &quot;b&quot;),<br />
				 ncol=1 ) +<br />
	scale_colour_viridis_d( name=&quot;Chain&quot;, direction=-1 ) +<br />
	theme_weird()</p>
<p>title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;Traceplot of Key Model Parameters&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.40) </p>
<p>titled_tp &lt;-<br />
	plot_grid(title, tp, ncol=1, rel_heights=c(0.1, 1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/poisson_traceplot.pdf&quot;,<br />
			 titled_tp,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )<br />
[/code]
</div></div>
</div>
<p>These traceplots exhibit the characteristic insane scribbling of well-mixed chains often referred to, in hushed whispers, as weirdly reminiscent of a <a href="https://druedin.com/2016/12/26/that-hairy-caterpillar/">hairy caterpillar</a>; the separate lines representing each chain are clearly overlapping and exploring the same forbidding regions. If, by contrast, the lines were largely separated or did not show the same space, there would be reason to believe that our model had become lost and unable to find a coherent voice amongst the myriad babbling murmurs of the data.</p>
<p>A second check on the sanity of the modelling process is to examine the output of the model itself to show the value of the fitted parameters of interest, and some diagnostic information:</p>
<pre class="brush: r; title: ; notranslate">
fit_ufo_pop_poisson %&gt;%
summary(pars=c(&quot;a&quot;, &quot;b&quot; )) %&gt;%
extract2( &quot;summary&quot; )
       mean      se_mean          sd      2.5%       25%       50%      75%     97.5%    n_eff      Rhat
a 4.0236045 1.026568e-04 0.004851688 4.0139485 4.0203329 4.0236485 4.026829 4.0330836 2233.626 0.9995597
b 0.5070227 6.206903e-05 0.002263160 0.5027733 0.5054245 0.5069979 0.508547 0.5115027 1329.477 1.0021745
</pre>
<p>For assessment of successful model fit, the <a href="https://github.com/stan-dev/stan/wiki/Stan-Best-Practices">Rhat</a> (&#92;(\hat{R}&#92;)) value represents the extent to which the various Markov chains exploring the parameter space, of which there are four by default in Stan, are consistent with each other. As a rule of thumb, a value of &#92;(\hat{R} \gt 1.1&#92;) indicates that the model has not converged appropriately and may require a longer set of random sampling iterations, or an improved model. Here, the values of &#92;(\hat{R}&#92;) are close to the ideal value of 1.</p>
<p>As a final step, we should examine how well our model can reproduce the shape of the original data. Models aim to be eerily lifelike parodies of the truth; in a Bayesian framework, and in the Stan language, we can build into the model the ability to draw random samples from the <em>posterior predictive distribution</em> &#8212; the set of parameters that the model has learnt from the data &#8212; to create new possible values of the outcomes based on the observed inputs. This process can be repeated many times to produce a multiplicity of possible outcomes drawn from model, which we can then visualize to see graphically how well our model fits the observed data.</p>
<p>In the Stan code above, this is created in the <code>generated_quantities</code> block. When using more convenient libraries such as <code>brms</code> or <code>rstanarm</code>, draws from the posterior predictive distribution can be obtained more simply after the model has been fit through a range of helper functions. Here, we undertake the process manually.</p>
<p>We can see, then, how well the Poisson distribution, informed by our selection of priors, has shaped itself to the underlying data.</p>
<figure id="attachment_610" aria-describedby="caption-attachment-610" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive.png"><img loading="lazy" decoding="async" data-attachment-id="610" data-permalink="https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/poisson_posterior_predictive-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="bvi02-poisson_posterior_predictive" data-image-description="" data-image-caption="&lt;p&gt;Posterior predictive density plot of fitted Poisson model.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive.png" alt="Posterior predictive density plot of fitted Poisson model." width="1920" height="1080" class="size-full wp-image-610" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-610" class="wp-caption-text">Posterior predictive density plot of fitted Poisson model. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_posterior_predictive.pdf">PDF Version</a>)</figcaption></figure>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show posterior predictive plot code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
[code language=&#8221;r&#8221;]
library( tidyverse )<br />
library( magrittr )<br />
library( lubridate )</p>
<p>library( ggplot2 )<br />
library( showtext )<br />
library( cowplot )</p>
<p>library( rstan )<br />
library( bayesplot )<br />
library( tidybayes )</p>
<p># Load UFO data<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p># UFO reporting font<br />
font_add( &quot;main_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
showtext_auto()</p>
<p># Plots, posterior predictive checking, LOO. </p>
<p># Bayesplot needs to be told which theme to use as a default.<br />
theme_set( theme_weird() )</p>
<p># Read the fitted model<br />
fit_ufo_pop_poisson &lt;- readRDS( &quot;work/fit_ufo_pop_poisson.rds&quot; )</p>
<p>## Model checking visualisations</p>
<p># Extract posterior estimates from the fit (from the generated quantities of the stan model)<br />
counts_pred_poisson &lt;- as.matrix( fit_ufo_pop_poisson, pars = &quot;counts_pred&quot; )</p>
<p># Posterior predictive density. (Visual representation of goodness of fit.)<br />
# Sample 50 rows for overlay<br />
counts_pred_sample &lt;-<br />
	counts_pred_poisson[ sample( nrow( counts_pred_poisson ), 50 ), ]
gp_ppc &lt;-<br />
	ppc_dens_overlay(<br />
						  y = extract2( ufo_population_sightings, &quot;count&quot; ),<br />
						  yrep = counts_pred_sample,<br />
						  alpha=0.4) +<br />
	theme_weird()</p>
<p>title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;Posterior Predictive Density Plot&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.40) </p>
<p>titled_gp_ppc &lt;-<br />
	plot_grid(title, gp_ppc, ncol=1, rel_heights=c(0.1, 1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/poisson_posterior_predictive.pdf&quot;,<br />
			 titled_gp_ppc,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )<br />
[/code]
</div></div>
</div>
<p>In the diagram above, the yellow line shows the densities of count values; the cyan lines show a sample of twisted mockeries spawned by our <a href="https://www.collinsdictionary.com/dictionary/french-english/poisson">piscine</a> approximations. The model has roughly captured the shape of the distribution of the original data, but demonstrates certain hideous dissimilarities &#8212; the peak of the posterior predictive distribution is significantly skewed away from the observed value.</p>
<p>To appreciate the full horror of what we have wrought we can plot the predictions of the model against the real data.</p>
<figure id="attachment_618" aria-describedby="caption-attachment-618" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot.png"><img loading="lazy" decoding="async" data-attachment-id="618" data-permalink="https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/poisson_predictive_plot-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="bvi02-poisson_predictive_plot" data-image-description="" data-image-caption="&lt;p&gt;Global poisson GLM of UFO sightings against population.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot.png" alt="Global poisson GLM of UFO sightings against population." width="1920" height="1080" class="size-full wp-image-618" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-618" class="wp-caption-text">Global poisson GLM of UFO sightings against population. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/poisson_predictive_plot.pdf">PDF Version</a>)</figcaption></figure>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show posterior predictive plot code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
[code language=&#8221;r&#8221;]
<p>library( tidyverse )<br />
library( magrittr )<br />
library( lubridate )</p>
<p>library( ggplot2 )<br />
library( showtext )<br />
library( cowplot )</p>
<p>library( rstan )<br />
library( bayesplot )<br />
library( tidybayes )<br />
library( modelr )</p>
<p># Load UFO data and model<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p>fit_ufo_pop_poisson &lt;-<br />
	readRDS(&quot;work/fit_ufo_pop_poisson.rds&quot;)</p>
<p># UFO reporting font<br />
font_add( &quot;main_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
font_add( &quot;bold_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
showtext_auto()</p>
<p># Plots, posterior predictive checking, LOO<br />
theme_set( theme_weird() )</p>
<p># Use teal colour scheme<br />
color_scheme_set( &quot;teal&quot;)</p>
<p>## Model checking visualisations</p>
<p># Extract posterior estimates from the fit (from the generated quantities of the stan model)<br />
counts_pred_poisson &lt;- as.matrix( fit_ufo_pop_poisson, pars = &quot;counts_pred&quot; )</p>
<p># US state data<br />
us_state_factors &lt;-<br />
	levels( factor( ufo_population_sightings$state ) )</p>
<p>## Create per-state predictive fit plots</p>
<p># Convert fitted model (stanfit) object to a tibble<br />
fit_tbl &lt;-<br />
	summary(fit_ufo_pop_poisson)$summary %&gt;%<br />
	as.data.frame() %&gt;%<br />
	mutate(variable = rownames(.)) %&gt;%<br />
	select(variable, everything()) %&gt;%<br />
	as_tibble()</p>
<p>counts_predicted &lt;-<br />
	fit_tbl %&gt;%<br />
	filter( str_detect(variable,&#8217;counts_pred&#8217;) ) </p>
<p>ufo_population_sightings_pred &lt;-<br />
	ufo_population_sightings %&gt;%<br />
	ungroup() %&gt;%<br />
	mutate( count_mean = counts_predicted$mean,<br />
			 lower = counts_predicted$`2.5%`,<br />
			 upper = counts_predicted$`97.5%`) </p>
<p># (Using mean and SD of fit summary)<br />
predictive_plot &lt;-<br />
	ggplot( ufo_population_sightings_pred ) +<br />
	geom_point( aes( x=population, y=count ), colour=&quot;#0b6788&quot;, size=0.6, alpha=0.8 ) +<br />
	geom_line(aes( x=population, y=count_mean ), colour=&quot;#3cd070&quot; ) +<br />
	geom_ribbon(aes(x=population, ymin = lower, ymax = upper ), alpha = 0.2, fill=&quot;#3cd070&quot;) +<br />
	labs( x=&quot;Population (Thousands)&quot;, y=&quot;Annual Sightings&quot; ) +<br />
	scale_fill_viridis_d( name=&quot;State&quot; ) +<br />
	scale_colour_viridis_d( name=&quot;State&quot; ) +<br />
	theme(<br />
			axis.title.y = element_text( angle=90 ),<br />
			legend.position = &quot;none&quot; )</p>
<p># Construct full plot, with title and backdrop.<br />
title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;UFO Sightings against State Population (1990-2014)&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;Poisson GLM. 50% credible intervals.&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.48) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.16) </p>
<p>data_label &lt;- ggdraw() +<br />
	draw_label(&quot;Data: http://www.nuforc.org | Tool: http://www.mc-stan.org&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=1, x=0.98 ) </p>
<p>predictive_plot_titled &lt;-<br />
	plot_grid(title, predictive_plot, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/poisson_predictive_plot.pdf&quot;,<br />
			 predictive_plot_titled,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )</p>
[/code]
</div></div>
</div>
<p>This shows a notably different line of best fit to that produced from the basic Gaussian model in the <a href="http://www.weirddatascience.net/index.php/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/">previous post</a>. The most visible difference is the curved predictor resulting from the &#92;(\log&#92;) link function, which appears to account for the changes in the data very differently to the constrained absolute linearity of the previous Gaussian model<span id='easy-footnote-16-559' class='easy-footnote-margin-adjust'></span><span class='easy-footnote'><a href='https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/#easy-footnote-bottom-16-559' title='A direct comparison is slightly more complex, as the output of &lt;code&gt;geom_smooth&lt;/code&gt; is a frequentist 95% &lt;a href=&quot;https://en.wikipedia.org/wiki/Confidence_interval&quot;&gt;&lt;em&gt;confidence interval&lt;/em&gt;&lt;/a&gt;, whereas this plot shows the Bayesian 95% &lt;a href=&quot;https://en.wikipedia.org/wiki/Credible_interval&quot;&gt;&lt;em&gt;credible interval&lt;/em&gt;&lt;/a&gt;. The difference between the two is beyond the scope of this post, but we will resolve this in our next steps.'><sup>16</sup></a></span>. Whether this is more or less effective remains to be seen.</p>
<h1>Unsettling Distributions</h1>
<p>In this post we have opened our eyes to the weirdly non-linear possibilities of generalised linear models; sealed and bound this concept within the wild philosophy of Bayesian inference; and unleashed the horrifying capacities of Markov Chain Monte Carlo methods and their manifestation in the Stan language.</p>
<p>Applying the Poisson distribution to our records of extraterrestrial sightings, we have seen that we can, to some extent, create a mindless <a href="https://www.amazon.co.uk/Golem-Second-Should-Science-Classics/dp/1107604656">Golem</a> that imperfectly mimics the original data. In the next post, we will delve more deeply into the esoteric possibilities of other distributions for count data, explore ways in which to account for arcane relationships across and between per-state observations, and show how we can compare the effectiveness of different models to select the final glimpse of dread truth that we inadvisably seek.</p>
<h2>Footnotes</h2>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2019/04/08/bayes-vs-the-invaders-part-two-abnormal-distributions/feed/</wfw:commentRss>
			<slash:comments>2</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">559</post-id>	</item>
		<item>
		<title>Bayes vs. the Invaders! Part One: The 37th Parallel</title>
		<link>https://www.weirddatascience.net/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/</link>
					<comments>https://www.weirddatascience.net/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/#comments</comments>
		
		<dc:creator><![CDATA[moth]]></dc:creator>
		<pubDate>Wed, 03 Apr 2019 13:03:10 +0000</pubDate>
				<category><![CDATA[beyond the veil]]></category>
		<category><![CDATA[scraping]]></category>
		<category><![CDATA[stan]]></category>
		<category><![CDATA[ufo]]></category>
		<guid isPermaLink="false">http://www.weirddatascience.net/?p=503</guid>

					<description><![CDATA[<div class="mh-excerpt">From our earlier <a href="http://www.weirddatascience.net/index.php/2018/02/27/are-ufos-more-commonly-seen-near-us-military-bases/">studies of UFO sightings</a>, a recurring question has been the extent to which the frequency of sightings of inexplicable otherworldly phenomena depends on the population of an area. Intuitively: where there are more people to catch a glimpse of the unknown, there will be more reports of alien visitors. Is this hypothesis, however, true? Do UFO sightings closely follow population or are there other, less comforting, factors at work?</div> <a class="mh-excerpt-more" href="https://www.weirddatascience.net/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/" title="Bayes vs. the Invaders! Part One: The 37th Parallel">[...]</a>]]></description>
										<content:encoded><![CDATA[<h1>Introduction</h1>
<p>From our earlier <a href="http://www.weirddatascience.net/index.php/2018/02/27/are-ufos-more-commonly-seen-near-us-military-bases/">studies of UFO sightings</a>, a recurring question has been the extent to which the frequency of sightings of inexplicable otherworldly phenomena depends on the population of an area. Intuitively: where there are more people to catch a glimpse of the unknown, there will be more reports of alien visitors.</p>
<p>Is this hypothesis, however, true? Do UFO sightings closely follow population or are there other, less comforting, factors at work?</p>
<p>In this short series of posts, we will build a statistical model of UFO sightings in the United States, based on data <a href="http://www.weirddatascience.net/blog/index.php/">previously scraped</a> from the <a href="http://www.nuforc.org">National UFO Reporting Centre</a> and see how well we can predict the rate of UFO sightings based on state population.</p>
<p>This series of posts is part tutorial and part exploration of a set of modelling tools and techniques. Specifically, we will use Generalized Linear Models (GLMs), Bayesian inference, and the <a href="http://www.mc-stan.org">Stan</a> probabilistic programming language to unveil the relationship between unsuspecting populations of US states and the dread sightings of extraterrestrial truth that they experience.</p>
<h1>Data</h1>
<p>As mentioned, we will rely on data from <a href="http://www.nuforc.org">NUFORC</a> for extraterrestrial sightings.</p>
<p>For population data, we can rely on the the <a href="https://fred.stlouisfed.org/release?rid=118">FRED</a> database for historical US state-level census data. The combination of these datasets provides us with a count of UFO sightings per year for each state, and the population of that state in that year.</p>
<p>The downloading and scraping code is included here:</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show scraping code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p>ZSH script to download via `curl`<br />
[code language=&#8221;bash&#8221;]
#!/bin/zsh<br />
# Download US state-level population datasets from FRED<br />
# State series names are stored in the file &#8216;series_names&#8217; (downloaded from fred.stlouisfed.org)<br />
# &lt;https: fred.stlouisfed.org=&quot;&quot; release?rid=&quot;118&quot;&gt;<br />
#<br />
# The per-series requests is included below.&lt;/https:&gt;</p>
<p>export IFS=$&#8217;\n&#8217;</p>
<p># Download<br />
for state_series in $(cat series_names); do</p>
<p>curl -o &quot;output/$state_series.csv&quot; &quot;https://fred.stlouisfed.org/graph/fredgraph.csv?bgcolor=%23e1e9f0&amp;amp;chart_type=line&amp;amp;drp=0&amp;amp;fo=open%20sans&amp;amp;graph_bgcolor=%23ffffff&amp;amp;height=450&amp;amp;mode=fred&amp;amp;recession_bars=on&amp;amp;txtcolor=%23444444&amp;amp;ts=12&amp;amp;tts=12&amp;amp;width=1168&amp;amp;nt=0&amp;amp;thu=0&amp;amp;trc=0&amp;amp;show_legend=yes&amp;amp;show_axis_titles=yes&amp;amp;show_tooltip=yes&amp;amp;id=$state_series&amp;amp;scale=left&amp;amp;cosd=1900-01-01&amp;amp;coed=2018-01-01&amp;amp;line_color=%234572a7&amp;amp;link_values=false&amp;amp;line_style=solid&amp;amp;mark_type=none&amp;amp;mw=3&amp;amp;lw=2&amp;amp;ost=-99999&amp;amp;oet=99999&amp;amp;mma=0&amp;amp;fml=a&amp;amp;fq=Annual&amp;amp;fam=avg&amp;amp;fgst=lin&amp;amp;fgsnd=2009-06-01&amp;amp;line_index=1&amp;amp;transformation=lin&amp;amp;vintage_date=2019-03-04&amp;amp;revision_date=2019-03-04&amp;amp;nd=1900-01-01&quot;</p>
<p>done<br />
[/code]
<p>Necessary &#8216;series_names&#8217; file:<br />
[code language=&#8221;text&#8221;]
WAPOP<br />
GAPOP<br />
CAPOP<br />
MOPOP<br />
DSPOP<br />
ILPOP<br />
TXPOP<br />
NYPOP<br />
FLPOP<br />
ALPOP<br />
COPOP<br />
WIPOP<br />
AZPOP<br />
MIPOP<br />
NCPOP<br />
MAPOP<br />
CTPOP<br />
LAPOP<br />
OHPOP<br />
AKPOP<br />
TNPOP<br />
MNPOP<br />
NJPOP<br />
NMPOP<br />
ARPOP<br />
MDPOP<br />
PAPOP<br />
NVPOP<br />
IAPOP<br />
ORPOP<br />
T5POP<br />
DCPOP<br />
HIPOP<br />
NDPOP<br />
KYPOP<br />
VAPOP<br />
IDPOP<br />
KSPOP<br />
INPOP<br />
WVPOP<br />
RIPOP<br />
SCPOP<br />
MSPOP<br />
DEPOP<br />
MTPOP<br />
MEPOP<br />
NEPOP<br />
OKPOP<br />
WYPOP<br />
UTPOP<br />
NHPOP<br />
VTPOP<br />
SDPOP<br />
[/code]
<p>R code to combine data into tidy format<br />
[code language=&#8221;r&#8221;]
library( tidyverse )</p>
<p># Read all CSV files<br />
census_files &lt;- list.files( &quot;output&quot;, full.names=TRUE )</p>
<p># Join all data into a single table<br />
census_data &lt;-<br />
census_files %&gt;%<br />
map( read_csv ) %&gt;%																				# Read each file, forming a list with an element for each<br />
reduce( full_join, by=&quot;DATE&quot; ) %&gt;%															# Reduce (left to right) running a full join<br />
dplyr::arrange( DATE ) %&gt;%																		# Sort by date<br />
gather( key=&quot;state&quot;, value=&quot;population&quot;, -DATE ) %&gt;%									# Gather to long format<br />
transmute( date=DATE, state=str_replace( state, &quot;POP&quot;, &quot;&quot; ), population )		# Rename and tidy variables and names</p>
<p># Output to an .rds<br />
saveRDS( census_data, &quot;data/annual_population.rds&quot; )</p>
[/code]
</div></div>
</div>
<p>For ease, we will treat each year&#8217;s count of sightings as <em>independent</em> from the previous year&#8217;s &#8212; we do not make an assumption that the number of sightings in each year is based on the number of sightings in the previous year, but is rather due to the unknowable schemes of alien minds. (If extraterrestrials visitors were colonising areas in secrecy rather than making sporadic visits, and thus being seen repeatedly, we might not want to make such a bold assumption.) Each annual count will be treated as an individual, independent data point relating population to count, with each observation tagged by state.</p>
<p>For simplicity, particularly in building later models, we will restrict ourselves to sightings post 1990, roughly reflecting a period in which the NUFORC data sees a significant increase in reporting and thus relies less on historical reports. (NUFORC&#8217;s phone hotline has existed since 1974, and its web form since 1998.)</p>
<h1>An Awful Simplicity</h1>
<p>To begin, we start with the most basic form of model: a simple linear relationship between the count of sightings and the population of the state at that time. If sightings were purely dependent on population, it might be reasonable to assume that such a model would fit the data fairly well.</p>
<p>This relationship can be plotted with relative ease using the <code>geom_smooth()</code> function of <code>ggplot2</code> in R. For opening our eyes to the awful truth contained in the data, this is a useful first step.</p>
<figure id="attachment_539" aria-describedby="caption-attachment-539" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined.png"><img loading="lazy" decoding="async" data-attachment-id="539" data-permalink="https://www.weirddatascience.net/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/lm_ufo_population_sightings-combined-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="lm_ufo_population_sightings-combined" data-image-description="" data-image-caption="&lt;p&gt;Global linear regression of UFO sightings against population.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined.png" alt="Regression of UFO sightings against population." width="1920" height="1080" class="size-full wp-image-539" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-539" class="wp-caption-text">Global linear regression of UFO sightings against population. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-combined.pdf">PDF Version</a>)</figcaption></figure>
<p>While this graph does seem to support the argument that sightings increase with population <em>in general</em>, a closer inspection shows that the individual data points are clearly clustered. If we highlight the location of each data point, colouring points by US state, this becomes clearer:</p>
<figure id="attachment_541" aria-describedby="caption-attachment-541" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state.png"><img loading="lazy" decoding="async" data-attachment-id="541" data-permalink="https://www.weirddatascience.net/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/lm_ufo_population_sightings-state-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="lm_ufo_population_sightings-state" data-image-description="" data-image-caption="&lt;p&gt;Global linear regression of UFO sightings against population with per-state colours.&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state.png" alt="Global linear regression of UFO sightings against population with per-state colours." width="1920" height="1080" class="size-full wp-image-541" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-541" class="wp-caption-text">Global linear regression of UFO sightings against population with per-state colours. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-state.pdf">PDF Version</a>)</figcaption></figure>
<p>This strongly suggests that, in preference to the simple linear model across all sightings, we might instead fit a linear model individually to each state:</p>
<figure id="attachment_543" aria-describedby="caption-attachment-543" style="width: 1920px" class="wp-caption aligncenter"><a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends.png"><img loading="lazy" decoding="async" data-attachment-id="543" data-permalink="https://www.weirddatascience.net/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/lm_ufo_population_sightings-trends-2/" data-orig-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends.png" data-orig-size="1920,1080" data-comments-opened="1" data-image-meta="{&quot;aperture&quot;:&quot;0&quot;,&quot;credit&quot;:&quot;&quot;,&quot;camera&quot;:&quot;&quot;,&quot;caption&quot;:&quot;&quot;,&quot;created_timestamp&quot;:&quot;0&quot;,&quot;copyright&quot;:&quot;&quot;,&quot;focal_length&quot;:&quot;0&quot;,&quot;iso&quot;:&quot;0&quot;,&quot;shutter_speed&quot;:&quot;0&quot;,&quot;title&quot;:&quot;&quot;,&quot;orientation&quot;:&quot;0&quot;}" data-image-title="lm_ufo_population_sightings-trends" data-image-description="" data-image-caption="&lt;p&gt;Per-state linear regression of UFO sightings against population,&lt;/p&gt;
" data-large-file="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends-1024x576.png" src="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends.png" alt="Per-state linear regression of UFO sightings against population," width="1920" height="1080" class="size-full wp-image-543" srcset="https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends.png 1920w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends-640x360.png 640w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends-300x169.png 300w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends-768x432.png 768w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends-1024x576.png 1024w, https://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends-64x36.png 64w" sizes="auto, (max-width: 1920px) 100vw, 1920px" /></a><figcaption id="caption-attachment-543" class="wp-caption-text">Per-state linear regression of UFO sightings against population. (<a href="http://www.weirddatascience.net/wp-content/uploads/2019/04/lm_ufo_population_sightings-trends.pdf">PDF Version</a>)</figcaption></figure>
<p>The code to produce the above graphs from the NUFORC and FRED data is given below:</p>
<div class="su-accordion su-u-trim">
<div class="su-spoiler su-spoiler-style-fancy su-spoiler-icon-chevron su-spoiler-closed" data-scroll-offset="0" data-anchor-in-url="no"><div class="su-spoiler-title" tabindex="0" role="button"><span class="su-spoiler-icon"></span>Show data preparation and visualization code.</div><div class="su-spoiler-content su-u-clearfix su-u-trim">
<p>Prepare and combine datasets:<br />
[code language=&#8221;r&#8221;]
library( tidyverse )<br />
library( magrittr )<br />
library( lubridate )</p>
<p># Prepare data for model fitting (and plotting)</p>
<p># Load US population and UFO datasets<br />
ufo &lt;- read_csv( &quot;data/ufo_spatial.csv&quot; )<br />
census &lt;- readRDS( &quot;data/annual_population.rds&quot; )</p>
<p># Process UFO data to per-state counts per year.<br />
# Drop Puerto Rico as we don&#8217;t have census data. (Also, very few sightings &#8212; 33 in dataset.)<br />
ufo_state_annual &lt;-<br />
	ufo %&gt;%<br />
	# US only<br />
	filter( country == &quot;us&quot; ) %&gt;%<br />
	# Apologies to Puerto Rico.<br />
	filter( state != &quot;pr&quot; ) %&gt;%<br />
	# Convert date to year, drop all other variables except state.<br />
	transmute( date = year( as.POSIXct( datetime, format=&quot;%m/%d/%Y %H:%M&quot; ) ), state=str_to_upper( state ) ) %&gt;%<br />
	# Group by year<br />
	group_by( date, state ) %&gt;%<br />
	# Sum sightings<br />
	summarize( count = n() )</p>
<p># Process census suitable for joining with UFO sightings.<br />
# Drop &quot;DS&quot; state entry &#8212; (&quot;Department of State&quot;?)<br />
census &lt;-<br />
	census %&gt;%<br />
	filter( state != &quot;DS&quot; ) %&gt;%<br />
	mutate( date=year( date ) ) </p>
<p># Join datasets<br />
ufo_population_sightings &lt;-<br />
	full_join( ufo_state_annual, census )</p>
<p># Missing data implies zero sightings.<br />
# Restrict to post-1990 to avoid a high proportion of very small numbers of<br />
# sightings.<br />
ufo_population_sightings &lt;-<br />
	ufo_population_sightings %&gt;%<br />
	mutate( count = replace_na( count, 0 ) ) %&gt;%<br />
	filter( !is.na( population ) ) %&gt;%<br />
	filter( date &gt;= 1990 ) %&gt;%<br />
	filter( date &lt;= 2014 )</p>
<p>saveRDS( ufo_population_sightings, &quot;work/ufo_population_sightings.rds&quot; )<br />
[/code]
<p>Fit linear trend in data via <code>geom_smooth()</code> using a linear model.<br />
[code language=&#8221;r&#8221;]
library( tidyverse )<br />
library( magrittr )<br />
library( lubridate )</p>
<p>library( ggplot2 )<br />
library( showtext )<br />
library( RColorBrewer )</p>
<p>library( cowplot )</p>
<p># Load UFO data<br />
ufo_population_sightings &lt;-<br />
	readRDS(&quot;work/ufo_population_sightings.rds&quot;)</p>
<p># UFO reporting font<br />
font_add( &quot;main_font&quot;, &quot;/usr/share/fonts/TTF/weird/Tox Typewriter.ttf&quot;)<br />
showtext_auto()</p>
<p># Combined plot ignoring states.<br />
ufo_pop_plot &lt;-<br />
	ggplot( ufo_population_sightings, aes( x=population, y=count )  ) +<br />
	geom_point( colour=&quot;#0b6788&quot;, size=0.6, alpha=0.8 ) +<br />
	geom_smooth( method=&quot;lm&quot;, colour=&quot;#3cd070&quot; ) +  # UFO green<br />
	xlab( &quot;Population&quot; ) +<br />
	ylab( &quot;Sightings per annum&quot; ) +<br />
	theme_weird() +<br />
	theme(<br />
			axis.title.y = element_text( angle=90 )<br />
			)</p>
<p># Construct full plot, with title and backdrop.<br />
title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;UFO Sightings against State Population (1990-2014)&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.40) </p>
<p>data_label &lt;- ggdraw() +<br />
	draw_label(&quot;Data: http://www.nuforc.org&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=1, x=0.98 ) </p>
<p>ufo_pop_titled &lt;-<br />
	plot_grid(title, ufo_pop_plot, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/lm_ufo_population_sightings-combined.pdf&quot;,<br />
			 ufo_pop_titled,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )</p>
<p># Combined plot colouring states.<br />
ufo_pop_plot_states &lt;-<br />
	ggplot( ufo_population_sightings, aes( x=population, y=count )  ) +<br />
	geom_point( aes( colour=state ), size=0.6, alpha=0.8 ) +<br />
	geom_smooth( method=&quot;lm&quot;, colour=&quot;#3cd070&quot; ) +  # UFO green<br />
	xlab( &quot;Population&quot; ) +<br />
	ylab( &quot;Sightings per annum&quot; ) +<br />
	scale_colour_manual( values=rep( brewer.pal( name=&quot;Set3&quot;, n=12 ), times=5 ) ) +<br />
	theme_weird() +<br />
	theme(<br />
			axis.title.y = element_text( angle=90 ),<br />
			legend.position=&quot;none&quot;<br />
			)</p>
<p># Construct full plot, with title and backdrop.<br />
title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;UFO Sightings against State Population (1990-2014)&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;(Per-state sightings)&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=16, hjust=0, vjust=1, x=0.02, y=0.48) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.16) </p>
<p>data_label &lt;- ggdraw() +<br />
	draw_label(&quot;Data: http://www.nuforc.org&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=1, x=0.98 ) </p>
<p>ufo_pop_states_titled &lt;-<br />
	plot_grid(title, ufo_pop_plot_states, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/lm_ufo_population_sightings-state.pdf&quot;,<br />
			 ufo_pop_states_titled,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )</p>
<p># Combined plot colouring states with per-state trend lines.<br />
ufo_pop_plot_states_trends &lt;-<br />
	ggplot( ufo_population_sightings, aes( x=population, y=count )  ) +<br />
	geom_point( aes( colour=state ), size=0.6, alpha=0.8 ) +<br />
	geom_smooth( method=&quot;lm&quot;, aes( colour=state ) ) +<br />
	xlab( &quot;Population&quot; ) +<br />
	ylab( &quot;Sightings Per Annum&quot; ) +<br />
	scale_colour_manual( values=rep( brewer.pal( name=&quot;Set3&quot;, n=12 ), times=5 ) ) +<br />
	theme_weird() +<br />
	theme(<br />
			axis.title.y = element_text( angle=90 ),<br />
			legend.position=&quot;none&quot;<br />
			)</p>
<p># Construct full plot, with title and backdrop.<br />
title &lt;-<br />
	ggdraw() +<br />
	draw_label(&quot;UFO Sightings against State Population (1990-2014)&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=20, hjust=0, vjust=1, x=0.02, y=0.88) +<br />
	draw_label(&quot;(Per-state trends)&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=16, hjust=0, vjust=1, x=0.02, y=0.48) +<br />
	draw_label(&quot;http://www.weirddatascience.net | @WeirdDataSci&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=0, vjust=1, x=0.02, y=0.16) </p>
<p>data_label &lt;- ggdraw() +<br />
	draw_label(&quot;Data: http://www.nuforc.org&quot;, fontfamily=&quot;main_font&quot;, colour = &quot;#cccccc&quot;, size=12, hjust=1, x=0.98 ) </p>
<p>ufo_pop_states_trends_titled &lt;-<br />
	plot_grid(title, ufo_pop_plot_states_trends, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1)) +<br />
	theme(<br />
			panel.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
			plot.background = element_rect(fill = &quot;#222222&quot;, colour = &quot;#222222&quot;),<br />
	) </p>
<p>save_plot(&quot;output/lm_ufo_population_sightings-trends.pdf&quot;,<br />
			 ufo_pop_states_trends_titled,<br />
			 base_width = 16,<br />
			 base_height = 9,<br />
			 base_aspect_ratio = 1.78 )</p>
[/code]
</div></div>
</div>
<h1>Result</h1>
<p>The plots shown here strongly indicate that the rate of dread interplanetary visitations per capita varies differently per state. It seems, therefore, that while the number of sightings is generally proportional to population, the specific relationship is state-dependent.</p>
<p>This simple linear model is, however, entirely unsatisfactory in describing the data, despite its support for the argument that different states have different underlying rates of sightings.</p>
<p>In the next post, therefore, we will delve deeper into the unsettling relationships between UFO sightings and the innocent humans to which they are drawn. To do so, we will have to consider a class of techniques that go beyond the normal distribution that underpins key assumptions of the simple linear models used here, and so move into the eldritch world of <em>generalized linear models</em>.</p>
]]></content:encoded>
					
					<wfw:commentRss>https://www.weirddatascience.net/2019/04/03/bayes-vs-the-invaders-part-one-the-37th-parallel/feed/</wfw:commentRss>
			<slash:comments>6</slash:comments>
		
		
		<post-id xmlns="com-wordpress:feed-additions:1">503</post-id>	</item>
	</channel>
</rss>
