Thanksgiving Dinner Survey Data Analysis and Visualization

Main dish and main way of preparation with stuffing

tg %>%
  count(main_dish, sort = T)

## # A tibble: 9 x 2
##   main_dish                  n
##   <chr>                  <int>
## 1 Turkey                   859
## 2 NA                        84
## 3 Other (please specify)    35
## 4 Ham/Pork                  29
## 5 Tofurkey                  20
## 6 Chicken                   12
## 7 Roast beef                11
## 8 I don't know               5
## 9 Turducken                  3

tg %>% 
  count(main_dish, main_prep, stuffing, sort = T) %>%
  drop_na() %>%
  mutate(main_dish = fct_lump(main_dish, n = 10, w = n),
         main_dish = fct_reorder(main_dish, n),
         stuffing = paste("stuffing:", stuffing)) %>% 
  ggplot(aes(main_dish, main_prep, size = n)) +
  geom_point() +
  coord_flip() +
  facet_wrap(~stuffing) +
  theme(
    axis.text.x = element_text(angle = 90)
  ) +
  geom_text(aes(y = main_prep, 
                x = main_dish, 
                label = if_else(n < 50, n, NULL)), 
            size = 4, 
            hjust = 1, 
            vjust = 1, 
            check_overlap = TRUE, 
            color = "red", 
            position = position_dodge(0.9)) +
  labs(y = "main preparation", 
       x = "main dish", 
       title = "# of survey respondents on Thanksgiving Meals",
       size = "# of survey respondents")

Prayer & Family Income

tg %>%
  count(family_income, prayer, sort = T) %>% 
  mutate(
    family_income = reorder(family_income, parse_number(family_income))
  ) %>%
  ggplot(aes(prayer, family_income, fill = n)) +
  geom_tile() +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 60) +
  labs(x = "say a prayer?", y = "family income", fill = "# of respondents",
       title = "Prayer & Family Income Correlation")

Prayer & Region

tg %>%
  count(us_region, prayer, community_type, sort = T) %>% 
  ggplot(aes(n, us_region, fill = prayer)) +
  geom_col(position = "stack") +
  facet_wrap(~community_type) +
  theme(
    strip.text = element_text(size = 12, face = "bold")
  ) +
  labs(x = "# of respondents", y = "US region", title = "Prayer & Region Relationship")

Pivot side, pie, and dessert

tg_pivot <- tg %>%
  select(-pie13, -dessert12, -side15) %>%
  pivot_longer(cols = starts_with("side"), names_to = "side_type", values_to = "side") %>% 
  pivot_longer(cols = starts_with("pie"), names_to = "pie_type", values_to = "pie") %>% 
  pivot_longer(cols = starts_with("dessert"), names_to = "dessert_type", values_to = "dessert")%>%
  separate(side, c("side"), sep = "/", extra = "drop")

tg_pivot %>%
  mutate(
    pie = case_when(
      pie == "Other (please specify)" ~ "Other",
      TRUE ~ as.character(pie)
    )
  ) %>%
  count(side, pie, dessert, sort = T) %>%
  drop_na() %>%
  mutate(
    side = fct_lump(side, n = 10, w = n),
    pie = fct_lump(pie, n = 10, w = n),
    dessert = fct_lump(dessert, n = 4, w = n)
  ) %>% 
  filter(!dessert %in% c("None", "Other")) %>%
  ggplot(aes(side, pie, fill = n)) +
  geom_tile()+
  facet_wrap(~dessert) +
  theme(
    axis.ticks = element_blank(),
    axis.text.x = element_text(angle = 90)
  ) +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 100) +
  labs(fill = "# of respondents")

First time of using position_jitterdodge().

tg %>% 
  mutate(kids_table_age = if_else(parse_number(kids_table_age) > 10 & parse_number(kids_table_age) < 21, "Between 11 and 20", kids_table_age),
         travel = case_when(
           travel == "Thanksgiving is happening at my home--I won't travel at all" ~ "No Travel (At Home)",
           travel == "Thanksgiving is local--it will take place in the town I live in" ~ "Local",
           travel == "Thanksgiving is out of town but not too far--it's a drive of a few hours or less" ~ "Short Travel",
           travel == "Thanksgiving is out of town and far away--I have to drive several hours or fly" ~ "Long Travel"
         )) %>%
  count(kids_table_age, travel, age, community_type, sort = T) %>%
  drop_na() %>%
  ggplot(aes(age, kids_table_age, size = n, color = community_type)) +
  geom_point(position = position_jitterdodge(jitter.width = 0.001, seed = 2021)) +
  facet_wrap(~travel) +
  labs(x = "age of respondent", y = "age of kids at table", size = "# of respondents", 
       color = "Community Type",
       title = "Respondent Age and Kids Table Age Relationship with Thanksgiving Travel",
       subtitle = "Community Type included") +
  theme(
    strip.text = element_text(size = 12, face = "bold")
  )

Others

The following code, with some variation, is inspired by David Robinson’s code for learning purposes.

food_pivot <- tg %>%
  select(id, starts_with("side"), starts_with("pie"), starts_with("dessert")) %>%
  select(-pie13, -dessert12, -side15) %>%
  pivot_longer(!id, names_to = "type", values_to = "value") %>%
  mutate(
    type = str_remove(type, "\\d+")
  ) %>%
  filter(!is.na(value))

n_respondents <- n_distinct(food_pivot$id)

food_pivot %>%
  count(type, value, sort = T) %>% 
  mutate(value = fct_reorder(value, n)) %>%
  filter(!value %in% c("Other (please specify)", "None")) %>% 
  ggplot(aes(n / n_respondents, value, fill = type)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ type, scales = "free_y", ncol = 1) +
  theme(
    strip.text = element_text(size = 12, face = "bold")
  ) +
  labs(x = "% of respondents", y = NULL) +
  scale_x_continuous(labels = percent)

food_pivot %>%
  inner_join(tg, by = "id") %>% 
  mutate(age_number = parse_number(age)) %>%
  group_by(value) %>%
  summarize(average_age = mean(age_number, na.rm = TRUE),
            total = n()) %>%
  arrange(desc(average_age))

## # A tibble: 34 x 3
##    value                       average_age total
##    <chr>                             <dbl> <int>
##  1 None                               42.5   335
##  2 Other (please specify)             41.9   316
##  3 Fruit salad                        41.3   215
##  4 Yams/sweet potato casserole        41.2   631
##  5 Coconut cream                      41.1    36
##  6 Squash                             40.5   171
##  7 Vegetable salad                    40.4   209
##  8 Pecan                              39.9   342
##  9 Apple                              39.8   514
## 10 Mashed potatoes                    39.8   817
## # ... with 24 more rows

food_pivot %>%
  inner_join(tg, by = "id") %>%
  group_by(us_region) %>%
  mutate(respondents = n_distinct(id)) %>%
  count(us_region, respondents, type, value) %>%
  ungroup() %>%
  mutate(percent = n / respondents)%>%
  filter(value == "Cornbread") %>%
  arrange(desc(percent))

## # A tibble: 10 x 6
##    us_region          respondents type  value         n percent
##    <chr>                    <int> <chr> <chr>     <int>   <dbl>
##  1 West South Central          85 side  Cornbread    34   0.4  
##  2 East South Central          56 side  Cornbread    16   0.286
##  3 Pacific                    130 side  Cornbread    37   0.285
##  4 South Atlantic             203 side  Cornbread    53   0.261
##  5 Mountain                    41 side  Cornbread    10   0.244
##  6 Middle Atlantic            145 side  Cornbread    33   0.228
##  7 NA                          33 side  Cornbread     7   0.212
##  8 New England                 55 side  Cornbread    10   0.182
##  9 West North Central          71 side  Cornbread    12   0.169
## 10 East North Central         145 side  Cornbread    23   0.159

tg %>%
  group_by(family_income) %>%
  summarize(celebrate = sum(celebrate == "Yes"),
            total = n(),
            low = qbeta(0.025, celebrate + .5, total - celebrate + .5),
            high = qbeta(0.975, celebrate + .5, total - celebrate + .5)) %>%
  ggplot(aes(family_income, celebrate / total, group = 1)) +
  geom_line() +
  geom_ribbon(aes(ymin = low, ymax = high), alpha = .2) +
  scale_y_continuous(labels = percent) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  labs(x = "Family income",
       y = "% celebrating Thanksgiving")

tg %>%
  filter(cranberry %in% c("Canned", "Homemade")) %>%
  group_by(family_income) %>%
  summarize(homemade = sum(cranberry == "Homemade"),
            total = n(),
            low = qbeta(0.025, homemade + .5, total - homemade + .5),
            high = qbeta(0.975, homemade + .5, total - homemade + .5)) %>%
  ggplot(aes(family_income, homemade / total, group = 1)) +
  geom_line() +
  geom_smooth(method = "lm") +
  geom_ribbon(aes(ymin = low, ymax = high), alpha = .2, fill = "orange") +
  scale_y_continuous(labels = percent) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  labs(x = "Family income",
       y = "% serving homemade")

Network Data

This is also my first time using widyr package, and I should say it is a bit strange to work on this, as food_pivot is has a special structure after pivot_longer().

food_cors <- food_pivot %>%
  pairwise_cor(value, id, sort = TRUE)

food_types <- food_pivot %>%
  count(value,sort = TRUE)

The original code from Robinson does not work here and it throws me an error message. Instead, I removed type from food_type and it worked. Network data structure is not easy to implement, especially when the output error messages are difficult to decipher. Maybe more practice and attention should be allocated in this area.

food_cors %>% 
  head(75) %>%
  graph_from_data_frame(vertices = food_types) %>%
  ggraph() +
  geom_edge_link() +
  geom_node_point(aes(size = n / n_respondents)) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1, repel = TRUE) +
  scale_size_continuous(labels = percent) +
  theme_void() +
  labs(title = "What foods get served together at Thanksgiving?",
       color = "",
       size = "% of respondents")

Conclusion

This is an interesting blog post that I first exposed to widyr and network data visualization. geom_ribbon(), which is also my first time to use, helps construct the lower and upper bound based on our preference. These skills are the fundamental building blocks of data processing and visualization.