Do airplane judgments differ across US regions?

For the second visualization, I wanted to see if there were any meaningful differences in rudeness judgments across different geographical regions of the US. Although there was typically regional variability within a particular judgment, no regions emerged as giving consistently harsh or lenient judgments across all behaviors.

Draft 1

figure_2a %>%
  filter(judgment == "yes") %>%
ggplot(aes(x = perc, y = fct_reorder(type, perc), color = location)) +
  geom_point(size = 2) +
  theme_minimal() +
  colorblindr::scale_color_OkabeIto(name = "location") +
  labs(x = "Percent judging the action as rude",
       y = NULL,
       title = "Rudest airplane behaviors by US division")+
  scale_x_continuous(labels = scales::percent,
                     limits = c(0, 1))

This is my first attempt to graph judgments of plane behaviors by region. I like this graph because you can see that some judgments are much more variable than others. However, I think there are too many locations, so I’m going to classify the divisions into the four regions (northeast, south, west, and midwest) delineated by the the United States Census Bureau.

Draft 2

library(emojifont)

figure_2b %>%
  mutate(plane_label = fontawesome('fa-plane')) %>% 
  filter(judgment == "yes") %>% 
ggplot(aes(x = perc, y = fct_reorder(type, perc), color = region, label = plane_label)) +
  geom_text(family='fontawesome-webfont', size=10, key_glyph = draw_key_point)+
  geom_vline(xintercept = 0.5, color = "gray40", linetype = "dashed")+
  theme_minimal(base_size = 30) +
  colorblindr::scale_color_OkabeIto() +
  labs(y = NULL,
       x = "Percent judging the action as rude",
       color = "US Region",
       title = "Rudest airplane behaviors by US region")+
  scale_x_continuous(labels = scales::percent,
                     limits = c(0, 1))

I made the points into airplanes with the emojifont package. Even though this looks cleaner, we are missing potentially valuable information about subdivisions by collapsing across regions. Additionally, it’s possible that we will be able to learn interesting information about how divisions that are close to each other (but maybe not in the same region) may be related to each other in judgments. For these reasons, I used facet_wrap() to plot judgments onto US maps.

Draft 3

ggplot(new_us) +
  geom_sf(aes(fill = perc), color = "black") +
  facet_wrap(~fct_reorder(type,perc, .desc = TRUE))+
  theme_void(base_size = 15)+
  labs(title = "Rudest airplane behaviors by US division",
       fill = "Percent judging\naction as rude",
       caption = "Data source: FiveThirtyEight") +
  scale_fill_gradient2(low = "#E69F00",
                       mid = "white",
                      high = "#56B4E9",
                      midpoint = .5,
                      limits = c(0, 1),
                      breaks = c(0, .5, 1),
                      labels = scales::percent) + 
  theme(legend.position = c(.15, -.05), 
        legend.direction = "horizontal",
        plot.margin = margin(b = 1, unit = "cm")) + theme(plot.title = element_text(size = 35),
      strip.text.x = element_text(size = 20, face = "bold"),
      text = element_text(family = "Times New Roman", size = 30),
      legend.title=element_text(size=20))

I considered different options for the colors and ended up on this one. The viridis continuous color palette would have made it easier to distinguish between midpoint high and midpoint low, but it didn’t match the colors for the rest of my plots and a blend of different colors from the OkabeIto color palette made an ugly gray color. Ultimately, I settled on this one, which does a good job at showing the main takeaway, that generally different regions agree on judgments. Next, I wanted to try to make it interactive. For my final plot, I used ggplotly() to convert my ggplot graph into an interactive plotly graph. When you hover over the states, you should see the percentage of people in the district who judged the act as rude. You should also be able to zoom in on a specific area.

Final draft

a <- new_us %>% 
  mutate(perc = round(perc, 2)) %>% 
  ggplot() +
  geom_sf(aes(fill = perc), color = "black") +
  facet_wrap(~fct_reorder(type,perc, .desc = TRUE))+
  theme_void(base_size = 10)+
  labs(title = "Rudest airplane behaviors",
       fill = "Percent who \nthinks act \nis rude",
       caption = "Data source: FiveThirtyEight") +
  scale_fill_gradient2(low = "#E69F00",
                       mid = "white",
                      high = "#56B4E9",
                      midpoint = .5,
                      limits = c(0, 1),
                      breaks = c(0, .5, 1),
                      labels = scales::percent)
library(plotly)

ggplotly(a, tooltip = c("location", "perc"))