In sadleskorn/apply303: Apply and Visualize

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

library(apply303)
library(tidyverse)
library(plotly)
library(dplyr)
library(lubridate)
library(fastR2)
library(knitr)

Sys.setenv('MAPBOX_TOKEN' = 'pk.eyJ1IjoiZGt3aWsiLCJhIjoiY2t6bm0zaXNsMjFleTJucGE4MXQ0a2x5ZCJ9.d3zS2uGrfhj_ZZ2-WNDNMg')

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"
  ) 
)