[Halloween Data Visualization Competition] UFO or Plane? Sighting locations compared to major airports

I was interested in exploring the relationship between the locations of the reported sightings with the locations of major airports.  By plotting the sighting locations with transparency, it is easy to identify dominant clusters.  The major airport locations are then plotted using a contrasting color to show that many of the sighting clusters correspond to the location of major airports. 

 

library(tidyr)
library(ggplot2)
library(choroplethrMaps)

# Create dataframe with locations for the top 40 airports
# only 39, since Honolulu won't be included in this graphic for contigous US only
airport_code <- c('BOS','OAK','MCI','PHX','SFO','LAX','EWR','DAL','DCA','FLL','SLC','IAH','HOU','MIA','SEA','RDU','DTW','TPA','DFW','AUS','STL','ATL','BNA','LGA','IAD','PDX','SAN','MDW','SJC','DEN','PHL','JFK','ORD','BWI','MSP','MSY','CLT','LAS','MCO')

latitude <- c(42.3643, 37.7213, 39.2976, 33.4343, 37.6190, 33.9425, 40.6925, 32.8471, 38.8521, 26.0726, 40.7884, 29.9844, 29.6454, 25.7932, 47.4490, 35.8776, 42.2124, 27.9755, 32.8968, 30.1945, 38.7487, 33.6367, 36.1245, 40.7772, 38.9445, 45.5887, 32.7336, 41.7860, 37.3626, 39.8617, 39.8719, 40.6398, 41.9786, 39.1754, 44.8820, 29.9934, 35.2140, 36.0801, 28.4294)

longitude <- c(-71.0052, -122.2210,  -94.7139, -112.0120, -122.3750, -118.4080,  -74.1687, -96.8518,  -77.0377,  -80.1527, -111.9780,  -95.3414,  -95.2789,  -80.2906, -122.3090,  -78.7875,  -83.3534,  -82.5332,  -97.0380,  -97.6699,  -90.3700, -84.4281,  -86.6782,  -73.8726,  -77.4558, -122.5980, -117.1900,  -87.7524, -121.9290, -104.6730,  -75.2411,  -73.7789,  -87.9048,  -76.6683,  -93.2218,  -90.2580,  -80.9431, -115.1520,  -81.3090)

top_us_airports <- data.frame(airport_code,latitude,longitude)

# Fill in US Country field where missing
ufo_country <- df %>%
  dplyr::mutate(state_uc=toupper(state)) %>%
  dplyr::mutate(country_uc=ifelse(country=='' & state_uc %in% c('AL', 'AK', 'AZ', 'AR', 'CA', 'CO', 'CT', 'DE', 'FL', 'GA', 'HI', 'ID', 'IL', 'IN', 'IA', 'KS', 'KY', 'LA', 'ME', 'MD', 'MA', 'MI', 'MN', 'MS', 'MO', 'MT', 'NE', 'NV', 'NH', 'NJ', 'NM', 'NY', 'NC', 'ND', 'OH', 'OK', 'OR', 'PA', 'RI', 'SC', 'SD', 'TN', 'TX', 'UT', 'VT', 'VA', 'WA', 'WV', 'WI', 'WY') ,"US", toupper(country)))

# Filter to only US sightings
ufo_us <- ufo_country %>%
  dplyr::filter(country_uc=='US')

# import state map data
data(state.map)

# For plotting, exclude alaska and hawaii
# Also filter by long and lat to exclude possible entry errors that fall outside of the contigious US
ufo_continental_us <- ufo_us %>%
dplyr::filter(!(state_uc %in% c('AK','HI')) & longitude>=-179.1473 & longitude <=-66.94989 & latitude>=18.91747 & latitude<=50 )

state_map_continental_us <- state.map %>%
  dplyr::filter(!(region %in% c('alaska','hawaii')))

# Make sure that longitude and latitude fields are numeric and continuous
ufo_continental_us$longitude <- as.numeric(ufo_continental_us$longitude)
ufo_continental_us$latitude <- as.numeric(ufo_continental_us$latitude)


# combine ufo and airport data to single data frame for plotting purposes
ufo_temp <- ufo_continental_us %>%
dplyr::select(longitude, latitude) %>%
dplyr::mutate(type= "UFO Sighting")

airport_temp <- top_us_airports %>%
dplyr::select(longitude, latitude) %>%
dplyr::mutate(type = "Top 40 Airport")

combined_df <- rbind(ufo_temp, airport_temp)

# create plot
state_map_plot <- ggplot() +
# plot map
geom_polygon(data=state_map_continental_us, aes(x=long, y=lat,    group=group), color="grey30", fill="black") +
# plot points for sightings and airports
geom_point(data=combined_df, aes(x=longitude, y=latitude, colour=type, shape=type, alpha=type, size=type),  show.legend=TRUE)  +
# specify colors, shape, size, and transparency of points by type
scale_colour_manual(values = c("#D600AD","#ABED00"))+
scale_shape_manual(values = c(18,16)) +
scale_alpha_discrete(range = c(.75,1/20)) +
scale_size_discrete(range=c(3,1)) +
# specify size and transparency of points for legend only
guides(color= guide_legend(override.aes=list(size=4, alpha=1)))+
# customize appearances
 theme(legend.position = c(0.13,0.15),
       legend.title=element_blank(),
       legend.background = element_rect(fill="white",size=0.5, linetype="solid", colour ="black"),
       plot.title = element_text(family="URWPalladio", face='bold', size=16, hjust=0.5),
       plot.subtitle=element_text(family="URWPalladio", size=12, hjust=0.5),
       axis.title.x=element_blank(),
       axis.text.x=element_blank(),
       axis.ticks.x=element_blank(),
       axis.title.y=element_blank(),
       axis.text.y=element_blank(),
       axis.ticks.y=element_blank(),
       panel.border=element_blank(),
       panel.grid.major=element_blank(),
       panel.grid.minor=element_blank(),
       panel.background = element_rect(fill = "white", colour = "white")) +
# Add text
labs(title="UFO or Plane?",
     subtitle="Location of Observed UFO Sightings from 1985 to 2014 within the Contiguous US\nCompared to Location of Top 40 US Airports",
     caption = "Sources: http://www.fi-aeroweb.com/Top-100-US-Airports.html, https://openflights.org/data.html, Kaggle UFO sighting data")

 periscope.image(state_map_plot)
1reply Oldest first
  • Oldest first
  • Newest first
  • Active threads
  • Popular
reply to topic
Like5 Follow
  • 5 Likes
  • 2 wk agoLast active
  • 1Replies
  • 129Views
  • 2 Following