maps – Weird Data Science

Numbers of the Beast: Sasquatch Distribution Modelling

moth — Mon, 21 Jul 2025 18:09:01 +0000

Dredged from the stygian depths of last year’s waning: a cruelly belated artefact of academia’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.

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.

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.

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.

OII Halloween Lecture
Sasquatch Distribution Modelling: Investigating patterns of Bigfoot sightings in North America.
Prof. Joss Wright
Oxford. October 2024

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.

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.

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.

To embrace this dark season, you are invited to the annual Oxford Internet Institute Halloween Lecture.

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?

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?

sasquatch_distribution_modelling

Whisperings in the Academy

moth — Sun, 20 Nov 2022 13:12:43 +0000

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.

In pursuit of such necessarily painful revelations the Oxford Internet Insitute at the University of Oxford — the unwitting host on which the investigations here parasitise — 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.

For the terminally inquisitive, the archival materials on which this work was drawn are presented here.

bayes_vs_invaders

Missing Links: Density of Bigfoot Sightings in North America

moth — Sun, 14 Oct 2018 22:15:40 +0000

Sightings of Homo sapiens cognatus, or Homo sylvestris, are well-recorded, with a particular prevalence in North America. Bigfoot, otherwise known as the Sasquatch, is one of the most widely-reported cryptids in the world; it is the subject of documentaries, film, music, and countless books.

The Bigfoot Field Research Organisation has compiled a detailed database of Bigfoot sightings going back to the 1920s. Each sighting is dated, located to the nearest town or road, and contains a full description of the sighting. In many cases, sightings are accompanied by a follow-up report from the organisation itself.

As previously with UFO sightings and paranormal manifestations, our first step is to retrieve the data and parse it for analysis. Thankfully, the bfro.net dataset is relatively well-formatted; reports are broken down by region, with each report following a mainly standard format.

As before, we rely on the rvest package in R to explore and scrape the website. In this case, the key elements were to retrieve each state’s set of reports from the top level page, and retrieve the link for each report. Conveniently, these are in a standard format; the website also allows a printer-friendly mode that greatly simplifies scraping.

The scraping code is given here:

Show scraping code.

[code language=”r”]

library(tidyverse)
library(progress)
library(rvest)

# Base URLs for scraping
index_url <- "https://www.bfro.net/GDB/"
base_url <- "https://www.bfro.net"
report_base_url_pattern <- "https:\\/\\/www.bfro.net\\/GDB\\/show_report.asp\\?id="

# Retrieve list of state-level county report pages
get_state_listing_urls <- function( url ) {

read_html( url ) %>%
html_nodes( ‘a’ ) %>%
html_attr( ‘href’ ) %>%
str_match( ‘.*state_listing.asp\\?state=.*’ ) %>%
na.omit %>%
unique %>%
{ paste0( base_url, . ) }

}

# Return all URLs pointing to a county-level list of reports
get_county_report_urls <- function( url ) {

read_html( url ) %>%
html_nodes( ‘a’ ) %>%
html_attr( ‘href’ ) %>%
str_match( ‘.*show_county_reports.asp\\?state=.*’ ) %>%
na.omit %>%
unique %>%
{ paste0( index_url, . ) }

}

# Return all URLs pointing to a report in this page.
get_report_urls <- function( url ) {

read_html( url ) %>%
html_nodes( ‘a’ ) %>%
html_attr( ‘href’ ) %>%
str_match( ‘.*show_report.asp\\?id=[0-9]+’ ) %>%
na.omit %>%
unique %>%
{ paste0( index_url, . ) }

}

progressive_get_county_report_urls <- function( url, progress_bar ) {

progress_bar$tick()$print()
cat( paste(url, "\n") , file="work/progress.log", append=TRUE )
chime()
get_county_report_urls( url )

}

progressive_get_report_urls <- function( url, progress_bar ) {

progress_bar$tick()$print()
cat( paste(url, "\n") , file="work/progress.log", append=TRUE )
get_report_urls( url )

}

# Pull the report listing from a page.
store_report <- function( url ) {

report_id <-
url %>%
str_replace( report_base_url_pattern, "" ) %>%
str_replace( "/", "-" ) %>%
str_replace( ".html", "" )

#message( paste0("Processing report ", report_id, "… " ), appendLF=FALSE )

# Check if this report has already been stored.
if( file.exists( paste0( "data/", report_id, ".rds" ) ) ) {
message( paste0( "Report already retrieved: ", report_id ) )
return()
}

url_pf <- paste0( url, "&PrinterFriendly=True" )

report <-
tryCatch(
{
# Fetch and parse HTML of current page.
read_html( url_pf ) %>%
as.character
},
error=function( cond ) {
message( paste( "URL caused an error:", url ))
message( "Error message:")
message( cond )
return( NULL )
},
warning=function( cond ) {
message( paste( "URL caused a warning:", url ))
message( "Warning message:")
message( cond )
return( NULL )
},
finally={
}
)

# Write report result to disk
saveRDS( report, paste0("data/", report_id, ".rds") )

}

# Progressive version of store_report
progressive_store_report <- function( url, progress_bar ) {

progress_bar$tick()$print()
cat( paste(url, "\n") , file="work/progress.log", append=TRUE )
store_report( url )

}

# The key to this is that links of the form
# <https://www.bfro.net/GDB/show_county_reports.asp?state=…>
# link to each state’s data. At the top level, then, we can just get all links matching that form.

# At each sub-page, the links are:
# <https://www.bfro.net/GDB/show_report.asp?id=…>
# We can just pull all of those for each state.
# NOTE: There are also non-US reports linked like this directly from the main GDB page.

# Finally, it seems that adding "&PrinterFriendly=True" will strip a lot of
# unnecessary formatting.

# From the top-level page, get every URL that matches ‘show_county_reports.asp?state=’, make
# the list unique, then download the pages.

# Get all non-US state indices
message("Getting state report lists…", appendLF=FALSE )
bfro_state_indices <- get_state_listing_urls( index_url )
message("done." )
saveRDS( bfro_state_indices, "work/bfro_state_indices.rds" )

# Get all US county-level indices
message("Getting county-level report urls… " )
pb <- progress_estimated( length( bfro_state_indices ) )
bfro_county_urls <-
bfro_state_indices %>%
map( progressive_get_county_report_urls, pb ) %>%
unlist %>%
unique
saveRDS( bfro_county_urls, "work/bfro_county_urls.rds" )

# Get URLs of US reports from county pages.
# (Final subset line handles cases where pages are empty of reports, but
# contain other links such as media articles.)
pb <- progress_estimated( length( bfro_county_urls ) )
bfro_report_urls <-
bfro_county_urls %>%
map( progressive_get_report_urls, pb ) %>%
unlist %>%
unique %>%
str_subset( "GDB\\/." )
saveRDS( bfro_report_urls, "work/bfro_report_urls.rds" )

# Store all US reports
pb <- progress_estimated( length( bfro_report_urls ) )
bfro_report_urls %>%
map( progressive_store_report, pb )

# Get all non-US indices
message("Getting non-US top-level report lists…", appendLF=FALSE )
bfro_nonus_indices <-
get_county_report_urls( index_url ) %>%
str_replace( "GDB\\/\\/", "\\/" )
message("done." )
saveRDS( bfro_nonus_indices, "work/bfro_nonus_indices.rds" )

# Get URLs of US reports from county pages
message("Getting non-US report lists…", appendLF=FALSE )
pb <- progress_estimated( length( bfro_nonus_indices ) )
bfro_nonus_report_urls <-
bfro_nonus_indices %>%
map( progressive_get_report_urls, pb ) %>%
unlist %>%
unique %>%
str_subset( "GDB\\/." )
saveRDS( bfro_nonus_report_urls, "work/bfro_nonus_report_urls.rds" )

# Store all US reports
pb <- progress_estimated( length( bfro_nonus_report_urls ) )
bfro_nonus_report_urls %>%
map( progressive_store_report, pb )

[/code]

With each page retrieved, we step through and parse each report. Again, each page is fairly well-formatted, and uses a standard set of tags for date, location, and similar. The report parsing code is given here:

Show parsing code.

[code language=”r”]

# NOTES

# Process entire list to check for standardised headers. These are in capitals, and located in tags.

# Report starts with:
# 
# (Look up what these mean.)
# Some following types contain general summary information, eg:
# " Submitted by witness on Thursday, November 1, 2007."
# Following fields are in span tags separated by paragraph tags, eg:
# YEAR: 2007
# STATE and COUNTY fields are typically links; we should pull their text. (I can’t see a good reason to parse links to anything other than the link text for our purposes.)

library(tidyverse)
library(magrittr)
library(progress)
library(rvest)
library(lubridate)

# Exploratory functions

# List all capitalised fields seen in any file
list_all_fields <- function() {

filenames <- list.files( "data", pattern="*.rds", full.names=TRUE)

# In each file, select the classes, match the uppercase field names, and extract text.
all_fields <-
filenames %>%
map( list_report_fields ) %>%
unlist %>%
unique

saveRDS( all_fields, "work/fields.rds" )

return( all_fields )

}

fields_to_colnames <- function( fields ) {

# In total there are 18 fields reported in the data, with the final one
# being an apparently miscoded date and place from a report.

# Format the text appropriately for dataframe column names
fields %>%
head( 17 ) %>%
str_remove( ":" ) %>%
str_replace_all( " ", "_" ) %>%
str_to_lower()

}

list_report_fields <- function( report ) {

to_process <- readRDS( report )

bfro_fields <- NULL

if( !is.null( to_process ) ) {
bfro_fields <-
to_process %>%
read_html %>%
html_nodes( "span" ) %>%
html_nodes(xpath = ‘//*[@class="field"]’) %>%
html_text %>%
str_subset( "[A-Z]+:" )
}

return( bfro_fields )
}

# Extract node date
parse_report_data <- function( report_data ) {

# report_data should be an xml_nodeset

# Metadata
metadata_list <-
report_data %>%
html_text %>%
str_subset( "^[A-Z ]+: " ) %>%
str_split_fixed( ": ", 2 ) %>%
as.tibble %>%
spread( key=V1, value=V2 ) %>%
set_colnames( fields_to_colnames( colnames(.) ) )

# Extra details
extra_text <-
report_data %>%
html_text %>%
str_remove( "^[A-Z ]+:.*" ) %>%
str_flatten( " " ) %>%
str_trim

# Add extra details as a column
metadata_list$extra <- extra_text

# Note whether date is rough or accurately reported
metadata_list$rough_date <- FALSE

# "Fix" missing date or month columns
if( "date" %in% colnames( metadata_list ) == FALSE ) {
metadata_list$date <- "1"
metadata_list$rough_date <- TRUE
}

if( "month" %in% colnames( metadata_list ) == FALSE ) {
metadata_list$month <- "January"
metadata_list$rough_date <- TRUE
}

# Combine date columns (year, month, date) to a true date.
metadata_list <-
metadata_list %>%
mutate( year = str_replace( year, ".*([0-9]{4}).*", "\\1" ) ) %>%
mutate( date = paste0( year, "-", month, "-", date ), year=NULL, month=NULL ) %>%
mutate( date = as.POSIXct( date, format="%Y-%B-%d" ) )

}

# Read a file and pass to `post_get_all_thread`
process_file <- function( filename ) {

# Read stored file
to_process <- readRDS( filename )

# Don’t process null files
if( is.null( to_process ) )
return( NULL )

if( length( to_process ) == 0 )
return( NULL )

# Produce an xml_nodeset for parsing
xml_thread <-
to_process %>%
read_html %>%
html_nodes( "p" )

parse_report_data( xml_thread )

}

# Progressive version of process_file
progressive_process_file <- function( filename, progress_bar ) {

progress_bar$tick()$print()
cat( paste(filename, "\n") , file="progress.log", append=TRUE )

report <-
tryCatch(
{
process_file( filename )
},
error=function( cond ) {
message( paste( "File caused an error:", filename ))
message( "Error message:")
message( cond )
return( NULL )
},
warning=function( cond ) {
message( paste( "URL caused a warning:", url ))
message( "Warning message:")
message( cond )
return( NULL )
},
finally={
}
)

return( report )

}

## Processing starts here

# Read all .rds data files and process into a thread
filenames <- list.files("data", pattern="*.rds", full.names=TRUE)
pb <- progress_estimated( length( filenames ) )

# Begin logging
cat( "Processing… ", file="progress.log", append=FALSE )

bfro_tbl <-
filenames %>%
map( progressive_process_file, pb ) %>%
bind_rows

saveRDS( bfro_tbl, "data/bfro_processed.rds" )

[/code]

With each report parsed into a form suitable for analysis, the final step in scraping the site is to geolocate the reports. As in previous posts, we rely on Google’s geolocation API. For each report, we extract an appropriate address and parse it into a set of latitude and longitude coordinates. For the purposes of this initial scrape we restrict ourselves to North America, which compromises a large majority of reports on bfro.net. Geolocation code is included below. (Note that a Google Geolocation API key is required for this code to run.)

Show geolocation code.

[code language=”r”]

library(googleway)
library(progress)
library(tidyverse)
library(magrittr)

# weird.data.science Google API key (Geocoding API enabled)
key <- <INSERT API KEY HERE>

# Load bfro tibble
bfro_data <- readRDS( "data/bfro_processed.rds" )

# Geocode entries

# BFRO entries contain some, all, or none of:
# country, province, state, county, nearest_town

# Country is only used for Canada, in which case a province is given.
# Country and province are NA for the US.

# Best plan, then is to create a string of (nearest_town, province, country) for Canadian results, and (nearest_town, county, state, "US") for US results.

# Bound the request to be only in North America.
# (Used: <https://boundingbox.klokantech.com>)
# (SW->NE latitude and longitude.)
bounding_box <- list( c( -170.3, 24.4),
c( -52.3, 83.3) )

form_location_string <- function( country, province, state, county, nearest_town ) {

location_string <- NA

# US case, then Canadian
if( is.na( country ) )
location_string <- paste0( nearest_town, ", ", county, ", ", state, ", US" )
else
location_string <- paste0( nearest_town, ", ", province, ", ", ", Canada" )

# Strip double commas caused by NA values and remove bracketed clauses.
location_string %<>%
str_remove_all( "\$[^\$]*\\)" ) %>%
str_replace_all( ", , ", ", " ) %>%
str_replace_all( " ,", "," ) %>%
str_remove_all( "NA, " )

}

# Create a safe version of google_geocode
safe_geocode <- safely( google_geocode )

# Wrap google_geocode with a progress bar call.
# Also, optionally remove any bracketed substrings entirely (strip_brackets)
progressive_geocode <- function( location_string, progress_bar ) {

# Write status to log file.
progress_bar$tick()$print()

cat( paste0( location_string, "\n" ), file="progress.log", append=TRUE )

result <-
safe_geocode(
address = location_string,
key = key,
bounds = bounding_box,
simplify = TRUE )

# Note that this can be NULL
return( result$result )

}

# Logging and output
## Clear the screen first
cat(c("\033[2J","\033[0;0H"))
cat("Geolocating entries…\n")
cat( "Geolocating entries…\n", file="progress.log", append=FALSE )

# Create the location string
bfro_data %<>%
mutate( location = form_location_string( country, province, state, county, nearest_town ) )

# Geolocate each location.
pb <- progress_estimated(nrow(bfro_data))
bfro_data$geolocation <-
map( bfro_data$location, progressive_geocode, progress_bar = pb )

cat("\nComplete.\n")

## With all values scraped, save geolocated data.
saveRDS( bfro_data, file="work/bfro_data_geolocated.rds")

[/code]

With geolocated data in hand, we can now venture into the wilds. In which areas of North America are Sasquatch most commonly seen to roam? The plot below shows the overall density of Bigfoot sightings, with individual reports marked.

Density of Bigfoot sightings in North America.

Density of Bigfoot sightings in North America. (PDF Version)

There are particular clusters on the Great Lakes, particularly in Southern Ontario; as well as in the Pacific Northwest. Smaller notable clusters exist in Florida, centered around Orlando. As with most report-based datasets, sightings are skewed towards areas of high population density.

The obvious first question to ask of such data is which, if any, environmental features correlate with these sightings. Other analyses of Bigfoot sightings, such as the seminal work of Lozier et al.¹, have suggested that forested regions are natural habitats for Sasquatch.

To answer this, we combine the underlying mapping data and Bigfoot sightings, with bioclimatic data taken from the Global Land Cover Facility. Amongst other datasets, this provides us with an accurate, high-resolution land cover raster map, detailing vegetation for each 5-arcminute cell in the country — approximately one cell per 10km² .

There are a range of bioclimatic variables in this dataset. The diagram below overlays all areas that are some form of forest onto the previous density plot.

Density of Bigfoot sightings in North America (Yellow) with forested areas overlaid (green).

Density of Bigfoot sightings in North America (yellow) with forested areas overlaid (green). (PDF Version)

The code for producing both of the above plots is given here:

Show density plotting code.

[code language=”r”]

library(spatstat)

library(rgdal)
library(maptools)

library(tidyverse)
library(magrittr)
library(ggplot2)
library(ggthemes)
library(raster)
library(viridis)
library(scales)

library(sf)

library(showtext)

library(grid)

library(cowplot)
library(magick)

# Load font
font_add( "mapfont", "/usr/share/fonts/TTF/weird/alchemy/1689 GLC Garamond Pro/1689GLCGaramondProNormal.otf" )
showtext_auto()

# Read world shapefile data and tranform to an appropriate projection.
world <- readOGR( dsn=’data/ne/10m_cultural’, layer=’ne_10m_admin_0_countries’ )
world_subset <- world[ world$iso_a2 %in% c("US","CA"), ] world_subset <- spTransform(world_subset,CRS("+init=epsg:4326 +lon_wrap=170"))
world_df <- fortify( world_subset )

# Read bfro database, filtering out locations with "NA" latitude or longitude.
# Also filter results that have been geolocated to "56.13037, -106.3468", which is the centroid of Canada, and results from locations having no more specific result.
bfro_tbl <-
readRDS( "data/bfro_locations.rds" ) %>%
filter( !is.na( lat ) & !is.na( lng ) ) %>%
filter( not( lat == modal( lat ) & lng == modal( lng ) ) )

# Convert the bfro dataframe to a spatial dataframe that contains
# explicit longitude and latitude projected appropriately for plotting.
coordinates( bfro_tbl ) <- ~lng+lat
proj4string( bfro_tbl ) <- CRS("+init=epsg:4326 +lon_wrap=170")
bfro_tbl_spatial <- spTransform(bfro_tbl,CRS(proj4string(bfro_tbl)))

# Restrict bfro_tbl to those points in the polygons defined by world_subset
bfro_tbl_rows <- bfro_tbl_spatial %>%
over( world_subset ) %>%
is.na() %>%
not() %>%
rowSums() %>%
`!=`(0) %>%
which

bfro_tbl <- as.tibble( bfro_tbl_spatial[ bfro_tbl_rows, ] )

# Create window for spatial analysis
bfro_owin <- as.owin.SpatialPolygons(world_subset)

# Function to plot density of a specific manifestation type.
# plot_resolution is for the density raster, and is mainly used for quick prototyping of the output.
density_plot <- function( density_res ) {

cat( paste0( "Plotting density: … " ) )

bfro_ppp <-
ppp(
x=coordinates(bfro_tbl_spatial)[,1],
y=coordinates(bfro_tbl_spatial)[,2],
window = bfro_owin
)

# This discards ‘illegal’ points outside of the window
bfro_ppp <- as.ppp(bfro_ppp)

bfro_density <- density( bfro_ppp, diggle=T, sigma=2, dimyx = c( density_res, density_res ) )

# Make density image object usable by ggplot as a raster
bfro_density_raster <- raster( bfro_density )
bfro_raster_tbl <- as.tibble( rasterToPoints( bfro_density_raster ) )

# Show the map
gp <- ggplot()

# Add density of sightings as raster.
gp <- gp +
geom_raster( data = bfro_raster_tbl, aes( x=x, y=y, fill = layer ), alpha=0.8, show.legend=FALSE ) +
scale_fill_viridis( option = "cividis", direction=1 )

# Add sightings as points.
gp <- gp +
geom_point( data = as.tibble( bfro_ppp ), aes( x=x, y=y ), colour="yellow", size=0.1, alpha=0.5, show.legend=FALSE )

gp <- gp +
geom_map( data = world_df, aes( map_id=id ), colour="#3c3f4a", fill = "transparent", size = 0.4, map = world_df )

# Theming
gp <- gp +
theme_map()

gp <- gp +
theme(
plot.background = element_rect(fill = "transparent", colour = "transparent"),
panel.border = element_blank(),
)

gp <- gp +
guides( fill = guide_colourbar( title.position="top", direction="horizontal", barwidth=6, barheight=0.4 ) )

cat("done.\n" )
return(gp)

}

# Add bioclimatic points to an existing plot
add_bioclimatic_variables <- function( gp, bioclim = seq( 1, 16 ) ) {

# This gets climatic variables for global range.
# (res=0.5 requires latitude and longitude to define a tile to download,
# but 2.5 minutes of a degree is ~5 miles, so probably good enough.)
#wc <- getData( ‘worldclim’, res=2.5, var=’bio’ )

# Value Label
# 0 Water
# 1 Evergreen Needleleaf forest
# 2 Evergreen Broadleaf forest
# 3 Deciduous Needleleaf forest
# 4 Deciduous Broadleaf forest
# 5 Mixed forest
# 6 Closed shrublands
# 7 Open shrublands
# 8 Woody savannas
# 9 Savannas
# 10 Grasslands
# 11 Permanent wetlands
# 12 Croplands
# 13 Urban and built-up
# 14 Cropland/Natural vegetation mosaic
# 15 Snow and ice
# 16 Barren or sparsely vegetated
# 254 Unclassified
# 255 Fill Value

glcf <- raster( "~/opt/datasets/gis/landcover/glcf/LC_5min_global_2012.tif" )

# We can’t just reproject a raster to wrap differently.
# This splits and merges the two edges.
# (This is fragile, unfortunately, but works here.)
# (Reprojecting is best done as the last step, apparently.)
glcf_west <- crop(glcf, extent(-180, 0, 18, 84))
glcf_east <- crop(glcf, extent(0, 180, 18, 84))
extent(glcf_west) <- c(180, 360, 18, 84)
glcf <- merge(glcf_west, glcf_east )

glcf <- crop( glcf, extent( world_subset ) )
glcf <- projectRaster( glcf, crs = CRS("+init=epsg:4326") )

# Make density image object usable by ggplot as a raster
glcf_raster_tbl <- as.tibble( rasterToPoints( glcf ) )
colnames( glcf_raster_tbl ) <- c ("x", "y", "layer" )

# Add bioclimatic variables
gp <- gp +
geom_raster( data = glcf_raster_tbl[ which( glcf_raster_tbl$layer %in% bioclim ), ], alpha=0.8, aes( x=x, y=y ), fill="#7cfc00", show.legend=FALSE )

}

# Cowplot for full-panel plotting. (Parchment background).
theme_set(theme_cowplot(font_size=4, font_family = "mapfont" ) )

# Only calculate the density plot if it isn’t already stored on disk.
if( not( file.exists( "work/density_plot.rds" ) ) ) {
gp <- density_plot( 1024 )
saveRDS( gp, "work/density_plot.rds" )
} else {
gp <- readRDS( "work/density_plot.rds" )
}

# Create a plot including the bioclimatic variables.
bioclim_gp <-
add_bioclimatic_variables( gp, seq( 1, 5 ) )

# Construct full plot, with title and backdrop.
title <- ggdraw() +
draw_label("Bigfoot Sightings in North America", fontfamily="mapfont", colour = "#3c3f4a", size=20, hjust=0, vjust=1, x=0.02, y=0.88) +
draw_label("http://www.weirddatascience.net | @WeirdDataSci", fontfamily="mapfont", colour = "#3c3f4a", size=12, hjust=0, vjust=1, x=0.02, y=0.40)

data_label <- ggdraw() +
draw_label("Data: http://www.bfro.net", fontfamily="mapfont", colour = "#3c3f4a", size=12, hjust=1, x=0.98 )

tgp <- plot_grid(title, gp, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1))

parchment_plot <- ggdraw() +
draw_image("img/parchment.jpg", scale=1.4 ) +
draw_plot(tgp)

save_plot("output/bigfoot-density.pdf",
parchment_plot,
base_width = 16,
base_height = 9,
base_aspect_ratio = 1.78 )

# Add bioclimatic variables to plot.
title <- ggdraw() +
draw_label("Bigfoot Sightings in North America Showing Forest Cover", fontfamily="mapfont", colour = "#3c3f4a", size=20, hjust=0, vjust=1, x=0.02, y=0.88) +
draw_label("http://www.weirddatascience.net | @WeirdDataSci", fontfamily="mapfont", colour = "#3c3f4a", size=12, hjust=0, vjust=1, x=0.02, y=0.40)

data_label <- ggdraw() +
draw_label("Data: http://www.bfro.net", fontfamily="mapfont", colour = "#3c3f4a", size=12, hjust=1, x=0.98 )

tgp <- plot_grid(title, bioclim_gp, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1))

parchment_plot <- ggdraw() +
draw_image("img/parchment.jpg", scale=1.4 ) +
draw_plot(tgp)

save_plot("output/bigfoot-density-forest.pdf",
parchment_plot,
base_width = 16,
base_height = 9,
base_aspect_ratio = 1.78 )

[/code]

From this initial plot we can see that, whilst tree cover is certainly not a bad predictor of Bigfoot sightings, it is far from a definitive correlation. The largest cluster, around the US-Canada border near Toronto, is principally lakes; whilst the secondary cluster in Florida is neither significantly forested or even close to the Everglades, which might have been expected. From the other perspective, there are significant forested areas for which sightings are reasonably rare.

The mystery of Bigfoot’s natural habitat and preferences is, therefore, very much unanswered from our initial analysis. With a broad range of variables still to explore — climate, altitude, food sources — future posts will attempt to determine what conditions lend themselves to strange survivals of pre-human primate activity. Perhaps changing conditions have pushed our far-distant cousins to previously unsuspected regions.

Until then, we keep following these trails into data unknown.

References

Mapping Paranormal Manifestations in the British Isles

moth — Tue, 10 Apr 2018 20:08:23 +0000

In our last entry we analysed the relative frequency of paranormal manifestations in the British Isles according to the Paranormal Database. The results of that analysis showed that hauntings of various forms are by far the most commonly-reported paranormal encounter in the British Isles, followed by cryptozoological sightings.

This is, however, relatively unsatisfactory. It is much more interesting to know where such sightings and events occur. Are there particular haunts of restless spirits? Do mysterious beasts roam in particular regions more than others? To answer these questions, we need to delve into the specific locations of different reports.

The Paranormal Database does contain location information, but it is given very informally. To map this we can make use of Google’s Geolocation API to convert free text strings, such as “Felbrigg Hall, Norfolk” into usable latitude and longitude coordinates. (In this case: 52.907479, 1.259443.)

The geolocation is not perfect, but with sufficient manipulation of the service it was possible to produce geolocated coordinates for most of the entries in the database. In order to represent these meaningfully, we have also subdivided the entries into a different types. The original Paranormal Database data is subdivided into twenty categories, which we have reduced to six for easier presentation. This includes collapsing the various kinds of haunting, from poltergeists to ‘post-mortem manifestions’, simply to hauntings. Similarly, we combine alien big cats and shuck into the broader family of cryptozoology.

With this in place, we can see the overall distribution of paranormal events in the British Isles.

Paranormal manifestations in the British Isles.

Paranormal manifestations in the British Isles. (PDF Version.)

As might be expected, London is a dark and sinister nexus of paranormal activity. Hauntings, as might be expected from their overall frequency, dominate the majority of the British Isles. Moving north, particularly as we reach the Scottish Highlands, cryptozoological sightings begin to challenge hauntings as the most common supernatural event. We can also see significant cryptozoology in the Hebrides, Orkney, and Shetland — the archipelagos that surround the Scottish mainland.

Both Wales, Ireland, and Cornwall are significantly less densely haunted in the Paranormal Database, with the majority of sightings falling in England.

This overall view, however, combines a number of very different phenomena. Where, for example, are we most likely to receive a visitation from a restless spectre as opposed to being pursued by a savage and unnatural beast?

By breaking down the sightings into different types, and plotting a heatmap of event density over each, we can identify the regions in which different manifestations cluster.

Density plot of paranormal manifestations in the British Isles

Density plot of paranormal manifestations in the British Isles. (PDF Version.)

This view highlights several points of interest.

Firstly, London’s preeminent position is not for all forms of paranormal activity. Hauntings are extremely dense in London, however the rest of England is also well-populated. As might be expected from the first diagram, the less population-dense regions further north have produced fewer sad echoes of mortality. Despite its general reputation Edinburgh, while noticeably haunted, cannot compare with many regions of England.

Cryptozoologically, however, London is far from dominant. Whilst unknown beings may lurk in the foetid sewers of the capital, they clearly prefer the wide open spaces — both the Norfolk and Suffolk Broads are rife with cryptids, as are the Hebrides, Orkney, and Shetland that were noticeable earlier. Finally, visitors to Cornwall will pass through areas of increasing monstrous activity.

UFO’s also appear to be attracted to East Anglia most strongly, and are otherwise most common in the large population centres of England. Less obviously, there is a noticeable density of UFO activity on the Pembrokeshire Coast, in the south-west of Wales.

Monsters, which in this classification includes werewolves, vampires, and dragons, produce a surprising cluster in North Wales, around Snowdonia. The most significant monstrous sightings, however, appear to be in Exmoor; again on the south-western tip of the British Isles.

The final categories of manifestation include legends, fairies, and a catch-all category of ‘other manifestations’ that include mysterious orbs, talking trees, bleeding stones, and the supernatural impressions left by the work of John Dee. As might be expected, this last category is more uniformly distributed across the country, matching high-density population areas. There is, however, another notable cluster in Cornwall for this category.

In conclusion, then, the British Isles are teeming with paranormal activity. Entities from beyond the grave lie close at all times, with twisted monstrosities roaming the wild spaces. UFOs descend from the night sky to terrorise the coastal regions.

From this analysis, ghost hunters should concentrate on London for the best chance of a sighting, although almost any of the large centres of population provide a reasonable chance of spectral apparitions. Cryptid researchers should concentrate in East Anglia or head north to the islands beyond Scotland. Those seeking contact with extraterrestrials should focus particularly on the east coast of Suffolk, or travel to the south-west of Wales. Paranormal investigators whose interests lie in legends or monsters, or less specific strange entities, would be well-advised to visit Cornwall.

Code for the plotting elements of this analyis are given below, following on from the scraping and parsing code in our previous post. The geolocation step required a more significant effort, and will be the focus of a future code-based post.

You can keep up to date with our latest paranormal data mining on Twitter at @WeirdDataSci.

Show analysis code

Data:

The Paranormal Database: http://www.paranormaldatabase.com

Other:

JSL Ancient font: http://www.1001fonts.com/jsl-ancient-font.html
Cowplot: https://cran.r-project.org/web/packages/cowplot/vignettes/introduction.html

Combined Plot Code:

[code language=”r”] library(spatstat)

library(rgdal)
library(maptools)

library(tidyverse)
library(magrittr)
library(ggplot2)
library(ggthemes)
library(raster)
library(viridis)
library(scales)

library(sf)

library(showtext)

library(grid)

library(cowplot)
library(magick)

# Function to combine certain paranormal report types into broader categories
combine_paranormal_types <- function( type ) {

# levels( paranormal_tbl$type )
# [1] "Alien Big Cat" "Crisis Manifestation"
# [3] "Cryptozoology" "Curse"
# [5] "Dragon" "Environmental Manifestation"
# [7] "Experimental Manifestation" "Fairy"
# [9] "Haunting Manifestation" "Legend"
# [11] "Manifestation of the Living" "Other"
# [13] "Poltergeist" "Post-Mortem Manifestation"
# [15] "Shuck" "Spontaneous Human Combustion"
# [17] "UFO" "Unknown Ghost Type"
# [19] "Vampire" "Werewolf"

# Simple lookup
case_when(
type %in% c("Alien Big Cat", "Cryptozoology", "Shuck") ~ "Cryptozoology",
type %in% c("Dragon", "Vampire", "Werewolf" ) ~ "Monster",
type %in% c("Crisis Manifestation", "Environmental Manifestation", "Experimental Manifestation", "Haunting Manifestation", "Manifestation of the Living", "Poltergeist", "Post-Mortem Manifestation", "Unknown Ghost Type") ~ "Haunting",
type %in% c("Legend", "Fairy", "Curse") ~ "Legend",
type %in% c("Spontaneous Human Combustion", "Other") ~ "Other",
type %in% c("UFO") ~ "UFO"
)

}

# Load font
font_add( "mapfont", "/usr/share/fonts/TTF/weird/JANCIENT.TTF" )
showtext_auto()

# Read world shapefile data and tranform to an appropriate projection.
# Limit to the UK, Ireland, and the Isle of Man
world <- readOGR( dsn=’data/ne/10m_cultural’, layer=’ne_10m_admin_0_countries’ )
world_subset <- world[ world$iso_a2 %in% c("GB","IE","IM"), ] world_subset <- spTransform(world_subset,CRS("+init=epsg:4326"))
world_df <- fortify( world_subset )

# Read paranormal database
paranormal_tbl <- as.tibble( read.csv( file="data/paranormal_database.csv" ) )

# Convert the paranormal dataframe to a spatial dataframe that contains
# explicit longitude and latitude projected appropriately for plotting.
coordinates( paranormal_tbl ) <- ~lng+lat
proj4string( paranormal_tbl )<-CRS("+init=epsg:4326")
paranormal_tbl <- spTransform(paranormal_tbl,CRS(proj4string(paranormal_tbl)))

# Restrict paranormal_tbl to those points in the polygons defined by world_subset
paranormal_tbl_rows <- paranormal_tbl %>%
over( world_subset ) %>%
is.na() %>%
not() %>%
rowSums() %>%
`!=`(0) %>%
which

paranormal_tbl <- as.tibble( paranormal_tbl[ paranormal_tbl_rows, ] )

paranormal_tbl$combined_type <- paranormal_tbl$type %>%
map( combine_paranormal_types ) %>%
unlist

# Show the map
gp <- ggplot() +

geom_map( data = world_df, aes( map_id=id ), colour = "#3c3f4a", fill = "transparent", size = 0.5, map = world_df )

# Display each sighting as geom_point. Use a level of transparency to highlight
# more common areas. (On the 20180401 dataset, this reports that 16035 out of
# the original 19387 points lie in the appropriate area. Several are geolocated
# outside of the UK — the geolocation should be run again with better bounds
# checking and region preference.)
gp <- gp + geom_point(data=paranormal_tbl, aes(x=lng, y=lat, colour=combined_type ), size=0.5, shape=17, alpha=0.9) +
expand_limits(x = world_df$long, y = world_df$lat)

gp <- gp +

# Theming
theme_map() +
theme(
plot.background = element_rect(fill = "transparent", colour = "transparent"),
panel.border = element_blank(),
plot.title = element_text( size=24, colour="#3c3f4a", family="mapfont" ),
text = element_text( size=14, color="#3c3f4a", family="mapfont" ),
) +

theme(
legend.background = element_rect( colour ="transparent", fill = "transparent" ),
legend.key = element_rect(fill = "transparent", colour="transparent"),
legend.position = "left",
legend.justification = c(0,0)
) +

guides( fill = guide_colourbar( title.position="top", direction="vertical", barwidth=32, nrow=1 ) ) +
guides(colour = guide_legend(override.aes = list(size=2)) ) +
scale_colour_manual(
values = c("#00EA38","#417CCC","#B79F00","#F564E3","#00BFC4","#F8766D"),
breaks = c("Haunting", "Cryptozoology", "Monster", "Legend", "UFO", "Other" ),
name = "Manifestation" ) +
coord_fixed( ratio=1.2 )

# Cowplot trick for ggtitle
title <- ggdraw() +
draw_label("Paranormal Manifestations in the British Isles", fontfamily="mapfont", colour = "#3c3f4a", size=24, hjust=0, vjust=1, x=0.02, y=0.88) +
draw_label("http://www.weirddatascience.net | @WeirdDataSci", fontfamily="mapfont", colour = "#3c3f4a", size=14, hjust=0, vjust=1, x=0.02, y=0.40)

data_label <- ggdraw() +
draw_label("Data from: http://www.paranormaldatabase.com", fontfamily="mapfont", colour = "#3c3f4a", size=12, hjust=1, x=0.98 )

paranormal_legend <- get_legend(gp)

# Remove legend from internal plot
gp <- gp + theme(legend.position=’none’)

tgp <- plot_grid(title, gp, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1))

vellum_plot <- ggdraw() +
draw_image("img/vellum.jpg", scale=1.4 ) +
draw_plot(tgp) +
draw_plot( paranormal_legend, 0.02, 0.03 )

save_plot("output/paranormal.pdf",
vellum_plot,
base_width = 16,
base_height = 9,
base_aspect_ratio = 1.78 )
[/code]

Per-Manifestation Density Plot Code:

[code language=”r”] library(spatstat)

library(rgdal)
library(maptools)

library(tidyverse)
library(magrittr)
library(ggplot2)
library(ggthemes)
library(raster)
library(viridis)
library(scales)

library(sf)

library(showtext)

library(grid)

library(cowplot)
library(magick)

# Function to combine certain paranormal report types into broader categories
combine_paranormal_types <- function( type ) {

}

# Load font
font_add( "mapfont", "/usr/share/fonts/TTF/weird/JANCIENT.TTF" )
showtext_auto()

# Read world shapefile data and tranform to an appropriate projection.
# Limit to the UK, Ireland, and the Isle of Man
world <- readOGR( dsn=’data/ne/10m_cultural’, layer=’ne_10m_admin_0_countries’ )
world_subset <- world[ world$iso_a2 %in% c("GB","IE", "IM"), ] world_subset <- spTransform(world_subset,CRS("+init=epsg:4326"))
world_df <- fortify( world_subset )

# Read UK Major Cities datafile
#cities <- readOGR( dsn=’data/ons_uk_cities’, layer=’Major_Towns_and_Cities_December_2015_Boundaries’ )
#cities <- spTransform(cities,CRS("+init=epsg:4326"))
#cities_fortified <- fortify( cities )
#cities_centroids_tbl <- as.tibble( coordinates( cities ) )
#cities_tbl <- as.tibble( cbind( cities@data$tcity15nm, cities_centroids_tbl ))
#colnames(cities_tbl) <- c( "city", "lng", "lat" )

# As the polygons are more confusing than useful, instead label centroids

# Read paranormal database
paranormal_tbl <- as.tibble( read.csv( file="data/paranormal_database.csv" ) )

paranormal_tbl$combined_type <- paranormal_tbl$type %>%
map( combine_paranormal_types ) %>%
unlist

# Convert the paranormal dataframe to a spatial dataframe that contains
# explicit longitude and latitude projected appropriately for plotting.
coordinates( paranormal_tbl ) <- ~lng+lat
proj4string( paranormal_tbl )<-CRS("+init=epsg:4326")
paranormal_tbl_spatial <- spTransform(paranormal_tbl,CRS(proj4string(paranormal_tbl)))

# Restrict paranormal_tbl to those points in the polygons defined by world_subset
paranormal_tbl_rows <- paranormal_tbl_spatial %>%
over( world_subset ) %>%
is.na() %>%
not() %>%
rowSums() %>%
`!=`(0) %>%
which

#paranormal_tbl <- as.tibble( paranormal_tbl_spatial[ paranormal_tbl_rows, ] )

# Create window for spatial analysis
paranormal_owin <- as.owin.SpatialPolygons(world_subset)

cat( paste0( "Plotting density: ", paranormal_type, "… " ) )

paranormal_tbl_spatial <- paranormal_tbl_spatial[ which( paranormal_tbl_spatial$combined_type == paranormal_type ), ]

paranormal_ppp <-
ppp( x=coordinates(paranormal_tbl_spatial)[,1],
y=coordinates(paranormal_tbl_spatial)[,2],
window = paranormal_owin )

# This discards ‘illegal’ points outside of the window
paranormal_ppp <- as.ppp(paranormal_ppp)

paranormal_density <- density( paranormal_ppp, diggle=T, sigma=0.4, dimyx=c(plot_resolution,plot_resolution) )

# Make density image object usable by ggplot as a raster
paranormal_density_raster <- raster( paranormal_density )
raster_tbl <- as.tibble( rasterToPoints( paranormal_density_raster ) )

# Show the map
gp <- ggplot() +

geom_map( data = world_df, aes( map_id=id ), colour = "#3c3f4a", fill = "transparent", size = 0.8, map = world_df ) +

# Add density of sightings as raster.
geom_raster( data = raster_tbl, alpha=0.8, aes( x=x, y=y, fill=layer), show.legend=TRUE ) +
scale_fill_viridis( option="magma", direction = -1, name="Density" )

gp <- gp +

# Theming
theme_map() +

theme(
plot.background = element_rect(fill = "transparent", colour = "transparent"),
panel.border = element_blank(),
plot.title = element_text( size=12, colour="#3c3f4a", family="mapfont" ),
text = element_text( size=12, color="#3c3f4a", family="mapfont" ),
) +

guides( fill = guide_colourbar( title.position="top", direction="horizontal", barwidth=6, barheight=0.4 ) ) +

# Fix the ratio of the plot to avoid distorting the UK
coord_fixed( ratio=1.2 )

cat("done.\n" )
return(gp)
}

# Calculate densities for each phenomenon
phenomena <- unique( paranormal_tbl$combined_type )

gp_list <- phenomena %>%
map( density_plot, 1024 )

# Plot as a grid with cowplot
theme_set(theme_cowplot(font_size=4, font_family = "mapfont" ) )
gp <- plot_grid( plotlist=gp_list,
labels = phenomena,
label_colour = "#3c3f4a" )

# Cowplot trick for ggtitle
title <- ggdraw() +
draw_label("Density of Paranormal Manifestations in the British Isles", fontfamily="mapfont", colour = "#3c3f4a", size=24, hjust=0, vjust=1, x=0.02, y=0.88) +
draw_label("http://www.weirddatascience.net | @WeirdDataSci", fontfamily="mapfont", colour = "#3c3f4a", size=14, hjust=0, vjust=1, x=0.02, y=0.40)

data_label <- ggdraw() +
draw_label("Data from: http://www.paranormaldatabase.com", fontfamily="mapfont", colour = "#3c3f4a", size=12, hjust=1, x=0.98 )

tgp <- plot_grid(title, gp, data_label, ncol=1, rel_heights=c(0.1, 1, 0.1))

vellum_plot <- ggdraw() +
draw_image("img/vellum.jpg", scale=1.4 ) +
draw_plot(tgp)

save_plot("output/paranormal-density.pdf",
vellum_plot,
base_width = 16,
base_height = 9,
base_aspect_ratio = 1.78 )
[/code]

Are UFOs more commonly seen near US military bases?

moth — Tue, 27 Feb 2018 21:30:38 +0000

What do they know?

Since the Roswell Incident in 1947, UFO’s have been associated with secretive military installations where mysterious craft dart across the night sky. Skeptics might hold that many UFO sightings, far from being extraterrestrial visitors, are better explained as experimental or conventional military craft. Does this association hold, though, in light of the wealth of UFO sightings collated by NUFORC? Are UFO’s more likely to be seen when in close proximity to a US airforce base?

Density plot of US-based UFO sightings plotted against locations of US airforce installations.

" data-image-caption="

UFO Sightings Density against US Airforce Installations

UFO Sightings Density against US Airforce Installations. (PDF | Print-Friendly PDF)

As a first step to approaching this question, we can rely on the reported NUFORC data of UFO sightings, and the US government’s conveniently thorough dataset of military installations.

Before performing a more robust statistical analysis, we can quickly combine these two datasets to see if any obvious visual patterns emerge. As always, visual analysis comes with the strong caveat that apparent patterns must be backed up with real statistics. Beware eyeballs.

We will focus only on sightings in the United States. Whilst the NUFORC dataset is creditably global the reports are overwhelmingly from the US, reflecting the fact that NUFORC is largely a US-based endeavour and is much less likely to receive reports from elsewhere in the world.

For this quick visual exploration, we will produce a density plot, or heatmap, of UFO sightings going back to 1906, using the excellent spatstat R package, as described in Baddeley, Rubak, and Turner’s Spatial Point Patterns: Methodology and Applications with R.

The first task is to transform the data appropriately from the weirdly non-Euclidean geometry of longitude and latitude to a geometry that allows for consistent measurement of distance between points. Following this we can run a standard kernel density estimate of sightings that, briefly, produces a probability distribution over the analysed space that estimates the likelihood of a UFO sighting at each point.

The output of spatstat’s density function is a pixel image, appropriate for plotting in R’s base graphics. As fanatical devotees of the cult of ggplot2, however, we instead convert this image to a raster suitable for plotting with ggplot’s geom_raster.

With the density plot calculated we can load the US military base data and perform a similar transform from longitude and latitude to Euclidean space. We then restrict the data to each active US Airforce installation, and plot the resulting set of points over the underlying density plot of UFO sightings. Being worthy of special attention, we highlight the location of Area 51.

At a first glance, there do seem to be correlations with particular clusters of airforce installations and UFO sightings. It is immediately obvious that sightings are much more common on the coasts of the US than in the centre of the continent, although the relatively sparse population density might go some way towards explaining this phenomenon.

The next step in this analysis, which we will carry out in a future post, will be to conduct a formal analysis of the correlation between the sightings density and the distance from airforce bases. From our initial observations, however, dark suspicions have already been raised.

You can keep up to date with our latest tearings of the mathematical veil on Twitter at @WeirdDataSci.

Show analysis code

Data:

NUFORC UFO Sightings Data compiled by Timothy Renner: https://data.world/timothyrenner/ufo-sightings
Natural Earth Small-Scale (1:100m) Physical Geographic Data: http://www.naturalearthdata.com
US Data.Gov Military Bases (National): https://catalog.data.gov/dataset/military-bases-national

Other:

Tox Typewriter font: https://www.dafont.com/tox-typewriter.font

Code:
[code language=”r”] library(spatstat)

library(rgdal)
library(maptools)

library(tidyverse)
library(ggplot2)
library(ggthemes)
library(raster)
library(viridis)
library(scales)

library(showtext)

# Load font
font.add( "mapfont", "font/Tox Typewriter.ttf")
showtext_auto()

# Read world shapefile data and tranform to an appropriate projection
world <- readOGR( dsn=’data/ne/110m_cultural’, layer=’ne_110m_admin_0_countries’ )
world.subset <- world[ world$continent %in% c("North America"), ] world.subset <- spTransform(world.subset,CRS("+init=epsg:4326"))

# Fortify world data for plotting
world.df <- fortify( world.subset )

# Get list of unique countries for processing.
countries.all <- data.frame( unique(world.df$id)[-1])
colnames( countries.all ) <- c("country")

# Get US military base data
us.mil <- readOGR( dsn=’data/usmil’, layer=’MIRTA_Points’ )
us.mil <- spTransform(us.mil,CRS("+init=epsg:4326"))

# UFO Sightings Data
ufo <- read.csv("data/scrubbed.csv", stringsAsFactors=FALSE)

# Convert latitude and longitude to numeric, and omit result NA values.
ufo$latitude <- as.numeric(ufo$latitude)
ufo$longitude <- as.numeric(ufo$longitude)
ufo <- na.omit( ufo )

# Convert the ufo dataframe to a spatial dataframe that contains explicit longitude and latitude projected appropriately for plotting.
coordinates( ufo ) <- ~longitude+latitude
proj4string( ufo )<-CRS("+init=epsg:4326")
ufo <- spTransform(ufo,CRS(proj4string(ufo)))

# Create window for spatial analysis
ufo.owin <- as.owin.SpatialPolygons(world.subset)
ufo.ppp <- ppp( x=coordinates(ufo)[,1], y=coordinates(ufo)[,2], window = ufo.owin, marks = ufo$shape )

# This discards ‘illegal’ points outside of the window
ufo.ppp <- as.ppp(ufo.ppp)

# Highlight Area 51
roswell.coords = cbind(-115.806999, 37.237 )
roswell.sp = SpatialPoints(roswell.coords)

proj4string( roswell.sp )<-CRS("+proj=longlat")
roswell.sp <- spTransform(roswell.sp,CRS("+init=epsg:4326"))
roswell.sp.df <- as.data.frame( coordinates( roswell.sp ) )
roswell.sp.df$text.label <- ‘Area 51’

# Get only active US airforce bases.
us.mil.airforce <- us.mil[ us.mil$COMPONENT == "AF Active", ] us.mil.ppp <- ppp( x=coordinates(us.mil.airforce)[,1], y=coordinates(us.mil.airforce)[,2], window = ufo.owin )
us.mil.ppp <- as.ppp( us.mil.ppp )
us.mil.sp <- as( us.mil.ppp, "SpatialPoints" )

# Calculate density of UFO sightings
ufo.density <- density( ufo.ppp, diggle=T, sigma=1.4, dimyx=c(2048,2048) )

# Make density image object usable by ggplot as a raster
ufo.density.raster <- raster(ufo.density)
raster.df <- as.data.frame( rasterToPoints( ufo.density.raster))

# Plot
gp <- ggplot() +

# Underlying map
geom_map( data = world.df, aes( map_id=id ), colour = "grey20", size = 0.5, map = world.df, show.legend = FALSE ) +

# Theming
theme_map() +
theme(
plot.background = element_rect(fill = "#444444"),
panel.border = element_blank(),
plot.title = element_text( size=24, colour="#cccccc", family="mapfont" ),
text = element_text( size=14, color="#cccccc", family="mapfont" ),
) +

theme(
legend.background = element_rect( colour ="#444444", fill = "#444444" ),
legend.key = element_rect(fill = "#ffffff", colour="#444444"),
legend.position = c(1,0),
legend.justification = c(1,0)
) +

guides( fill = guide_colourbar( title.position="top", direction="horizontal", barwidth=16 ) ) +

# Add density of sightings as raster.
geom_raster( data = raster.df, alpha=1, aes( x=x, y=y, fill=layer), show.legend=TRUE ) +

# Add density of sightings as raster.
geom_raster( data = raster.df, alpha=1, aes( x=x, y=y, fill=layer), show.legend=FALSE) +

# Colour using Viridis
scale_fill_viridis( option="magma" )

# Overlay US Airforce locations
dot.size <- 1.2
stroke.size <- 0.4

gp <- gp +
geom_point( data = as.data.frame( coordinates(us.mil.sp) ), aes( x=mx, y=my ), size=dot.size, stroke=stroke.size, shape=21, fill="#eeeeee", color="#222222" ) +

# Special case for Area 51
# Due to ggplot only supporting a single colour scale for the entire plot, there’s some awkwardness here in using ‘colour’ rather than ‘fill’ for the Area 51 dot and manually adding an outline. This lets us add an easy legend to the map, though, highlighting that location.
geom_point( data = roswell.sp.df, aes( x=coords.x1, y=coords.x2, colour=text.label ), size=1, stroke=0, show.legend=TRUE ) +
geom_point( data = roswell.sp.df, aes( x=coords.x1, y=coords.x2 ), size=1, stroke=stroke.size, shape=21, color="#222222" ) +
scale_colour_manual(values = c("red")) +
theme( legend.title = element_blank(), legend.background = element_rect( fill = "#444444" ), legend.key = element_rect(fill = "#444444") ) +

# Acknowledge data sources
labs( caption = "Data: http://www.nuforc.org | https://catalog.data.gov/dataset/military-bases-national" ) +

# Add our title
ggtitle("Density of UFO Sightings against Active US Airforce Installations", subtitle="http://www.weirddatascience.net | @WeirdDataSci")

# Output
ggsave( "output/base-density.pdf", width=16, height=9 )
[/code]

Unveiling the Global UFO Inquirer

moth — Thu, 22 Feb 2018 07:52:54 +0000

Our previous post showed an interactive map of UFO sightings drawn from the NUFORC dataset. Whilst this did allow us to see UFO sightings over time, it remained a relatively crude tool that created a static visualisation for each year.

In delving deeper into the NUFORC data, it has become useful to create a more interactive tool. As we believe in providing potentially dangerous knowledge to the woefully unprepared mind, the Weird Data Science laboratory trepidatiously unveils the Global UFO Inquirer.

Apologies, it seems that your browser doesn’t support iframes.

You can visit the Global UFO Inquirer directly here.

This is a Leaflet-based map, built on R and Shiny. The map can be explored at will, restricted to any range of dates, with each data point from the NUFORC dataset labelled. Clicking on the icon for a report will unveil the location, date, and details of that report.

This has highlighted that our initial dataset is sadly incomplete. Firstly, NUFORC reports are frequently updated and the dataset we have ends in 2014. Of greater importance, however, is that the dataset to which we have access contains only the summary details of each report, which is restricted to the first line of text. The NUFORC website contains the full details, but these are not currently in our dataset.

We will therefore be developing a scraper to extract the full data from the NUFORC website as it is updated and feed it into the Inquirer. There is existing code floating around the net to carry out part of this task, but more work is needed. As an initial step we will link each report in the Global UFO Inquirer to the full online NUFORC report, but full data in the tool is the ultimate goal.

You can keep up to date with our latest collating of statistical horror on Twitter at @WeirdDataSci.

Every day, the horror deepens.

Interactive Map of UFO Sightings by Year

moth — Sun, 18 Feb 2018 02:39:44 +0000

Whilst an overview of a century of UFO sightings reveals a broad overall feature of the data, it is far more useful to be able to see how sightings change over time.

The interactive plot below shows all sightings for a given year. We can clearly see that the number of reported UFO sightings greatly increases from the middle of the 1960s onward.

Apologies, it seems that your browser doesn’t support iframes.

You can visit this map directly here.

You can keep up to date with our latest presentations of the beyond on Twitter at @WeirdDataSci.

Happy hunting.

Global Distribution of UFO Sightings 1910-2013

moth — Fri, 16 Feb 2018 23:48:45 +0000

Where are you most likely to see a UFO? More importantly, where are they most likely to see you?

Thankfully, the National UFO Reporting Centre (NUFORC) have diligently compiled and curated a dataset of over a century of global UFO sightings. The data has been processed, cleaned, and uploaded by timothyrenner at data.world.

The full dataset is extremely detailed, with type of sighting, duration, latitude and longitude, and many other features included; there are many questions to ask of the data. As an initial offering for Weird Data Science, though, we will feed this dataset into R and get a feel for the global distribution of sightings in the dataset. The full code is at the bottom of this post, but here is the outcome:

What can we tell immediately? Firstly, there is a clear preference amongst UFO’s to descend on the United States, although Europe and in particular the United Kingdom receive their fair share of extraterrestrial visitations. The rest of the world is far from ignored, but our best hope of making contact would definitely seem to be in those two countries.

We will be analysing this dataset in much greater detail in the future. How have these sightings changed over time? Are there patterns to be discovered in when and where UFOs choose to reveal themselves? Are these events predictable? As always, the answers lie in the data.

You can keep up to date with our latest tinkerings with statistical reality on Twitter at @WeirdDataSci.

Show analysis code

Data:

NUFORC UFO Sightings Data compiled by Timothy Renner: https://data.world/timothyrenner/ufo-sightings
Natural Earth Small-Scale (1:100m) Physical Geographic Data: http://www.naturalearthdata.com/

Other:

Stake Through the Heart BB Regular font: http://www.blambot.com/font_stth.shtml

Code:

[code language=”r”] library(ggplot2)
library(ggthemes)
library(maptools)
library(rgdal)
library(rgeos)
library(showtext)

# UFO Sightings Data
ufo <- read.csv("data/scrubbed.csv", stringsAsFactors=FALSE)

# Read world shapefile data and tranform to an appropriate projection
world <- readOGR( dsn=’data/ne/110m_cultural’, layer=’ne_110m_admin_0_countries’ )
world <- spTransform(world,CRS("+proj=longlat"))

# Fortify world data, using iso_a2 country codes
world.df <- fortify( world, region = "iso_a2" )

# Get list of unique countries for processing.
countries.all <- data.frame( unique(world.df$id)[-1])
colnames( countries.all ) <- c("country")

# Convert latitude and longitude to numeric, and omit result NA values.
ufo$latitude <- as.numeric(ufo$latitude)
ufo$longitude <- as.numeric(ufo$longitude)
ufo <- na.omit( ufo )

# Convert the ufo dataframe to a spatial dataframe that contains explicit longitude and latitude projected appropriately for plotting.
coordinates( ufo ) <- ~longitude+latitude
proj4string( ufo )<-CRS("+proj=longlat")
ufo <- spTransform(ufo,CRS(proj4string(ufo)))

# With the data appropriate projected for display, convert back to a data frame for ggplot2.
ufo<-data.frame(ufo)

# Show the map
gp <- ggplot() +
geom_map( data = countries.all, aes( map_id = country), colour = "grey20", size = 0.2, map = world.df ) +
expand_limits(x = world.df$long, y = world.df$lat)

# Display each sighting as geom_point. Use a level of transparency to highlight more common areas.
gp <- gp + geom_point(data=ufo, aes(x=longitude, y=latitude), color="#0b6788", size=0.1, alpha=0.1)

# Load font
font.add( "mapfont", "/usr/share/fonts/TTF/weird/StakeThroughtheHeartBB_reg.otf")
showtext.auto()

# Provide some overall theming of the map
gp <- gp +
theme_map() +
theme(
plot.background = element_rect(fill = "#444444"),
panel.border = element_blank(),
text = element_text( size=32, color="white", family="mapfont" ),
plot.title = element_text( size=48, colour="white", family="mapfont" )
)

gp <- gp + labs( caption = "Data from: http://www.nuforc.org available at https://data.world/timothyrenner/ufo-sightings" )

# Add our title
gp <- gp + ggtitle("Global Distribution of UFO Sightings 1910-2013", subtitle="http://www.weirddatascience.net")

# Save
ggsave("ufo-sightings.png", width=8, height=4.5)
[/code]