ufo

#> ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
#> ✔ ggplot2 3.3.5     ✔ purrr   0.3.4
#> ✔ tibble  3.1.6     ✔ dplyr   1.0.8
#> ✔ tidyr   1.2.0     ✔ stringr 1.4.0
#> ✔ readr   2.1.2     ✔ forcats 0.5.1
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag()    masks stats::lag()
#> 
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#> 
#>     last_plot
#> The following object is masked from 'package:stats':
#> 
#>     filter
#> The following object is masked from 'package:graphics':
#> 
#>     layout
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union
#> Loading required package: mosaic
#> Registered S3 method overwritten by 'mosaic':
#>   method                           from   
#>   fortify.SpatialPolygonsDataFrame ggplot2
#> 
#> The 'mosaic' package masks several functions from core packages in order to add 
#> additional features.  The original behavior of these functions should not be affected by this.
#> 
#> Attaching package: 'mosaic'
#> The following object is masked from 'package:Matrix':
#> 
#>     mean
#> The following object is masked from 'package:plotly':
#> 
#>     do
#> The following objects are masked from 'package:dplyr':
#> 
#>     count, do, tally
#> The following object is masked from 'package:purrr':
#> 
#>     cross
#> The following object is masked from 'package:ggplot2':
#> 
#>     stat
#> The following objects are masked from 'package:stats':
#> 
#>     binom.test, cor, cor.test, cov, fivenum, IQR, median, prop.test,
#>     quantile, sd, t.test, var
#> The following objects are masked from 'package:base':
#> 
#>     max, mean, min, prod, range, sample, sum

Plot of UFOs sightings animated from the year 2000 onwards

ufos |> 
  plot_mapbox(frame = ~month) |> #frame creates animation
  layout(
    mapbox = list(
      style = "dark", #changes map style
      zoom = 2.4, 
      center = list(lat = 37, lon = -95) #centers on USA
    )
  ) |> 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 3, color = "#FFFFCC", opacity = 0.4), #creates glyph aesthetic
  ) |> 
  animation_opts(100) #sets the number of milliseconds per frame 

Plot of UFO sightings cumulative from 2000.

ufos1 <- ufos |> 
  plot_mapbox() |> 
  layout(
    mapbox = list(
      style = "dark", 
      zoom = 2.4, 
      center = list(lat = 37, lon = -95)
    )
  ) |> 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 2, color = "#FFFFCC", opacity = 0.2),
    text = ~paste("<b>Date/Time:</b>", datetime,"<br><b>Report:</b>", comments, "<br><b>City/State:</b>", city, ",", state),
    textposition = "auto",
    hoverlabel = list(align = "left"),
    hoverinfo = "text"
  ) 

ufos1

Reflection

I was quite frustrated about the animation. There were moments when the animation would jitter crazily when I made the frame rate higher. In order to make the animation smoother, I had to cut down the number of years it scrubbed through as well as lower the frame rate. Lots of tweaking to figure out what works.

I implemented the use of color and lightness in Wilke’s book to convey density in geospatial data. Since UFOs are often seen at night, I made the map background dark, and used light glyphs to emphasize higher intensity/concentration of sightings.

The story I am telling through this visualization is the increasing number and concentration of UFO sighting reports across the years. The animation and visualization also helps us see concentrations of regions that report sightings regularly.

Improvements

I took Tom Takeuchi’s idea of using crosstalk to create a multi-select bar for the plot, which selects years.

library(crosstalk)

ufos2 <- highlight_key(ufos, ~year)

widgets <- bscols(
  filter_select("Select a Year", "Select a Year", ufos2, ~year)
)

bscols(widths = c(3,9), widgets,
  ufos2 |> 
  plot_mapbox() |> 
  layout(
    mapbox = list(
      style = "dark", 
      zoom = 2.4, 
      center = list(lat = 37, lon = -95)
    )
  ) |> 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 2, color = "#FFFFCC", opacity = 0.2),
    text = ~paste("<b>Date/Time:</b>", datetime,"<br><b>Report:</b>", comments, "<br><b>City/State:</b>", city, ",", state),
    textposition = "auto",
    hoverlabel = list(align = "left"),
    hoverinfo = "text"
  ) 
)

Select a Year