A very important report on global UFO sightings and abductions

(But mainly a lesson on using R Markdown and GitHub Pages to share your work)

About and Credits

These materials were developed by Sam Csik & Juliette Verstaen using UFO Sighting Data from the National UFO Reporting Center (NUFORC). Data can be downloaded from kaggle. Source code can be found on GitHub.

In this example report, we demonstrate how to use a variety of different HTML widgets that allow for interactive web visualizations, as well as how to leverage R Markdown and GitHub Pages for building web pages to display reports (or whatever else you might dream of creating with RMarkdown).

Expand hidden Code chunks to see how we’ve created the following tables, maps, and plots. Also, be on the lookout for TIPs and RESOURCEs throughout for pointers and links to resources!

And finally, before we get started, the R Markdown Cookbook by Yihui Xie, Christophe Dervieux, & Emily Riederer and R Markdown: The Definitive Guide by Yihui Xie, J. J. Allaire, & Garrett Grolemund contain tons of incredible information and answers to nearly all of the R Markdown-related questions we have encountered. We recommend coming back to these to learn more about all-things R Markdown.

Setting up your R Markdown file

• customizing the YAML
• a note on code chunks
• markdown syntax
• creating tabs
• publishing your .Rmd as a GitHub Page

###########################
# load packages
###########################

# for cleaning and wrangling
library(tidyverse)
library(janitor)
library(lubridate) 

# for map making and general spatial work
library(leaflet)
library(mapview)
library(sf)

# for working with time series data
library(dygraphs)
library(xts)

# for making tables
library(DT)
library(gt)

# for palette making
library(RColorBrewer)
library(colorspace)
library(scales)

# for reproducibility
library(here)

##############################
# source custom alien color palette
##############################

source(here::here("code", "palettes.R"))

###########################
# load data
###########################

UFO_data_all <- read_csv(here::here("data", "UFO_complete.csv"))

###########################
# bunch of parsing failures from columns that are shifted; we're going to just filter those out bc they don't have appropriate lat/long data
###########################

# see parsing failures here
UFO_parsing_failures <- UFO_data_all %>% 
  filter(is.na(city))

# remove those from the dataset
UFO_data_cleaned <- UFO_data_all %>% 
 filter(!is.na(city))

Alien Encounters

Timeseries (dygraph)

##############################
# get colors from our custom alien palette
##############################

colors <- alien_palette("galaxy_quest", 8, "discrete")

##############################
# wrangle data
##############################

UFO_dygraph <- UFO_data_cleaned %>%
  clean_names() %>%
  select(-date_posted) %>%
  separate(datetime, c("month", "second", "third"), sep = "/") %>%
  separate(third, c("year", "time"), sep = " ") %>%
  group_by(year) %>%
  count() %>%
  rename(number_instances = n) %>%
  filter(!is.na(year)) %>%
  mutate(date_seen = paste("01/01/", year, sep = "")) %>%
  mutate(date_seen = as.character(date_seen),
         ## needs to be in date time format/class in order to be converted into extendable time series below
         date_seen = as.Date(date_seen, format = "%m/%d/%Y"))

##############################
# create time series object
##############################

ufo_timeseries <- xts(x = UFO_dygraph$number_instances,
                              order.by = UFO_dygraph$date_seen)

##############################
# finally create the plot
##############################

dy_plot <- dygraph(ufo_timeseries, main = "Aliens from Earth") %>%
  dyRangeSelector() %>%
  dyOptions(labelsUTC = TRUE, fillGraph=TRUE, fillAlpha=0.1, drawGrid = FALSE, colors= colors[1]) %>%
  dyCrosshair(direction = "vertical") %>%
  dyHighlight(highlightCircleSize = 5, highlightSeriesBackgroundAlpha = 0.2, hideOnMouseOut = FALSE) %>%
  dyRoller(rollPeriod = 1) %>%
  dyAxis("y", label = "Number of sightings, abductions, etc")

##############################
# display plot in knitted doc
##############################

dy_plot

RESOURCE: For more information and tips on (1) creating dygraphs, check out dygraphs for R (2) xts objects check this out

Mapping duration (mapview)

##############################
# clean data
##############################

UFO_time <- UFO_data_cleaned %>%
  clean_names() %>%
  select(-date_posted) %>%
  mutate(longitude = as.numeric(longitude),
         latitude = as.numeric(latitude)) %>%
  mutate(duration_length = case_when(duration_seconds <= 60 ~ "short",
                                     duration_seconds >= 360 ~ "long",
                                     T ~ "medium")) %>%
  filter(!is.na(longitude),
         !is.na(latitude)) %>%
  group_by(duration_length, longitude, latitude) %>%
  count() %>%
  rename(number_instances = n)

##############################
# need to convert to a spatial feature object
##############################

UFO_spatial <-  st_as_sf(UFO_time, coords = c("longitude", "latitude"),
           crs = 4326)

##############################
# create the map!
##############################

UFO_map_mv <- mapview(UFO_spatial, zcol = "duration_length", cex = "number_instances", alpha = 0.2)

##############################
# display map in knitted doc
##############################

UFO_map_mv

RESOURCE: Explore Jamie Montgomery’s mapview and mapedit tutorial from SB Eco-Data Science for more mapview fun.

Spaceship shapes (gt)

##############################
# get colors from our custom alien palette
##############################

colors_table <- alien_palette("galaxy_quest", 8, "discrete")

##############################
# wrangle data (get counts by UFO shape)
##############################

UFO_shape_count <- UFO_data_cleaned %>%
  clean_names() %>%
  select(-date_posted) %>%
  mutate(longitude = as.numeric(longitude),
         latitude = as.numeric(latitude)) %>%
  group_by(shape) %>%
  count() %>%
  rename(number_instances = n) %>%
  filter(!is.na(shape)) ## There are 28 unique shapes

##############################
# wrangle data (get total time each shape was viewed)
##############################

UFO_shape_times <- UFO_data_cleaned %>%
  clean_names() %>%
  select(-date_posted) %>%
  mutate(longitude = as.numeric(longitude),
         latitude = as.numeric(latitude)) %>%
  group_by(shape) %>%
  dplyr::summarise(total_seconds = sum(duration_seconds, na.rm = TRUE)) %>%
  filter(!is.na(shape))

##############################
# combine data frames
##############################

UFO_shape <- left_join(UFO_shape_count, UFO_shape_times) %>%
  mutate(shape_rate_seconds = total_seconds/number_instances) %>%
  mutate(Hours = hour(seconds_to_period(shape_rate_seconds)),
         Minutes = minute(seconds_to_period(shape_rate_seconds)),
         Seconds = round(second(seconds_to_period(shape_rate_seconds)), digits = 0)) %>%
  unite(shape_rate, c("Hours", "Minutes", "Seconds"), sep = ":") %>%
  ungroup()

##############################
# make the `gt` table
##############################

Table1_UFO_shapes <- UFO_shape %>%
  dplyr::arrange(desc(shape_rate_seconds)) %>%
  select(-shape_rate_seconds) %>%
  gt() %>%
  tab_header(title = "Alien Spaceship Shapes & Time in the Air") %>%
  cols_label(shape = "Shape",
             number_instances = "Number Sightings",
             total_seconds = "Total Seconds Observed",
             shape_rate = "Time per each Sighting")  %>%
  cols_align("center") %>%
  tab_options(
    table.background.color = colors[1]) %>%
  tab_style(
    style = list(
      cell_fill(color = colors[6]),
      cell_text(weight = "bold", color = colors[1])
    ),
    locations = cells_title(groups = "title")
  )

##############################
# display table in knitted doc
##############################

Table1_UFO_shapes

Alien Spaceship Shapes & Time in the Air
Shape	Number Sightings	Total Seconds Observed	Time per each Sighting
cone	367	26182820.0	19:49:3
sphere	5755	117463088.6	5:40:11
crescent	2	37810.0	5:15:5
other	6247	116627072.8	5:11:9
light	17872	219047085.2	3:24:16
diamond	1308	7997864.5	1:41:55
unknown	6319	31088140.3	1:21:60
flash	1472	7093452.4	1:20:19
circle	8453	36407947.3	1:11:47
fireball	6562	25138040.2	1:3:51
changed	1	3600.0	1:0:0
oval	4119	14619172.7	0:59:9
cylinder	1382	4400397.5	0:53:4
delta	8	16155.0	0:33:39
disk	6005	12119911.8	0:33:38
changing	2140	4137860.3	0:32:14
cigar	2241	4045685.0	0:30:5
egg	845	1439911.1	0:28:24
triangle	8489	13408958.2	0:26:20
formation	2657	3143588.3	0:19:43
teardrop	817	710229.5	0:14:29
cross	265	174465.0	0:10:58
rectangle	1418	910543.8	0:10:42
chevron	1007	492047.0	0:8:9
round	2	905.0	0:7:32
hexagon	1	240.0	0:4:0
pyramid	1	120.0	0:2:0
flare	1	30.0	0:0:30
dome	1	2.0	0:0:2

RESOURCE: Explore Juliette Verstaen’s gt R-Ladies workshop for more table fun.

Alien Abductions

All accounts of abductions (DT)

##############################
# clean up UFO_data to display in an interactive table
##############################

Table2_abduction_data <- UFO_data_cleaned %>% 
  clean_names() %>% # clean up those col headers using the janitor package
  filter(str_detect(comments, "(?i)abduction")) %>%  # filter for any comments that mention 'abduction'
  select(datetime, date_posted, country, state, city, duration_seconds, shape, comments) 

##############################
# generate an interactive table (using the `DT` package) 
##############################

Table2 <- datatable(Table2_abduction_data, # your data frame
                    class = 'cell-border stripe', 
                    colnames = c("Date/Time (of encounter)", "Date Reported", # rename column names
                                 "Country", "State", "City", "Duration of Encounter (sec)", 
                                 "Shape of UFO", "Comments"),
                    caption = htmltools::tags$caption( # add a caption
                      style = 'caption-side: top; text-align: left;', # set location/alignment of caption text
                      htmltools::em('Table 1: Global accounts of alien abductions from 1910-2013.')), # write caption
                    filter = 'top', 
                    options = list(pageLength = 5, autoWidth = TRUE)) # set number of viewable rows

##############################
# display table in knitted doc
##############################

Table2

RESOURCE: Explore DT: An R interface to the DataTables library for more ways to customize your DT tables.

Map of alien abductions (leaflet)

##############################
# wrangle data (get latitude, longitude, and all comments mentioning the word "abduction")
##############################

leaflet_abduction_data <- UFO_data_cleaned %>% 
  filter(str_detect(comments, "(?i)abduction")) %>% # filter for any comments mentioning 'abduction'
  mutate(latitude = as.numeric(latitude), # leaflet requires lat/long to be numeric values
         longitude = as.numeric(longitude))

###########################
# make a custom icon 
###########################

UFO_icon <- makeIcon(iconUrl = "media/ufo.png", # file path to saved .png (or URL)
                     iconWidth = 35, iconHeight = 45) # adjust size

###########################
# make interactive map (using the `leaflet` package)
###########################

abduction_map <- leaflet(leaflet_abduction_data) %>% 
  addProviderTiles(providers$CartoDB.Positron) %>% # add basemap and choose style
  addMarkers(lng = ~longitude, lat = ~latitude, icon = UFO_icon, popup = ~ comments) %>% # add UFO_icon as data points and show comments in the popup
  addMiniMap(tiles = providers$CartoDB.Positron, # add a mini map to show zoom coverage
             toggleDisplay = TRUE) # allows user to collapse mini map

###########################
# display map in knitted doc
###########################

abduction_map

RESOURCE: Explore Leaflet for R for more ways to customize your Leaflet maps.

Additional Resources

• The R Markdown Reference Guide is a great cheat sheet for Markdown syntax and knitr chunk options
• R Markdown Cheat Sheet (also find more cheatsheets for all things R/RStudio by clicking Help > Cheatsheets)
• For a list of awesome interactive htmlwidgets for R see here. Find even more options in the htmlwidgets gallery.
• A Guide to GitHub Pages. This is a cool choose-your-own-adventure-style resource if you’re comfortable in the command line.
• For creating your own palette, I use the ColorPick Eyedropper extension (for Chrome, for Firefox, but any color picking tool will work)