Customizing geom_text better

Question

For one of the past weeks' TidyTuesday challenges, I tried to plot the US House Elections results. Here is the code;

library(tidyverse)
library(showtext)
library(showtextdb)
library(geofacet)
library(ggthemes)
library(ggtext)
library(stringr)

font_add_google("Domine", bold.wt = 700, family = "title")
font_add_google("Roboto Slab", family = "subtitle") 
font_add_google("Spectral", family = "caption")

font_add('fa-reg', 'fonts/Font Awesome 6 Free-Regular-400.otf')
font_add('fa-brands', 'fonts/Font Awesome 6 Brands-Regular-400.otf')
font_add('fa-solid', 'fonts/Font Awesome 6 Free-Solid-900.otf')
showtext_auto()

house <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2023/2023-11-07/house.csv')

rep_votes_by_year <- house %>%
  filter(party == "REPUBLICAN") %>%
  group_by(state, year) %>%
  mutate(vote = sum(candidatevotes),
         total_vote = sum(totalvotes)) %>%
  select(state, party, vote) %>%
  ungroup() %>%
  distinct()

dem_votes_by_year <- house %>%
  filter(party == "DEMOCRAT") %>%
  group_by(state, year) %>%
  mutate(vote = sum(candidatevotes),
         total_vote = sum(totalvotes)) %>%
  select(state, party, vote) %>%
  ungroup() %>%
  distinct()


total_votes_by_states <- house %>%
  select(year, state, totalvotes) %>%
  distinct() %>%
  group_by(year, state) %>%
  mutate(total_votes = sum(totalvotes)) %>%
  select(year, state, total_votes) %>%
  distinct()


data <- rbind(rep_votes_by_year, dem_votes_by_year)
data_final <- total_votes_by_states %>%
  left_join(data, by = c("state", "year")) %>%
  mutate(percent = vote/total_votes,
         state = str_to_title(state),
         state = case_when(state == "District Of Columbia" ~ "District of<br>Columbia",
                           .default = as.character(state))) %>%
  filter(state != "Louisiana") 
  

grid <- geofacet::us_state_grid2
grid$name[grid$name == "District of Columbia"] <- "District of<br>Columbia"

plot <- ggplot(data_final,
       aes(x = year, y = percent, group = party, color = party)) +
  geom_line() +
  geom_point(data = data_final %>% filter(year == 2022), 
             aes(x = year, y = percent, group = party, color = party), size = 0.7) +
  geom_text(data = data_final %>% filter(year == 2022) %>% mutate(y_placement = percent, y_placement = ifelse(percent > 0.5, y_placement + 0.15, y_placement-0.15)), 
            aes(x = year, y = y_placement, label = round(percent, 2)), size = 10, nudge_x = -2,
            check_overlap = TRUE) +
  facet_geo(~state, grid = grid) +
  theme_fivethirtyeight() +
  labs(title = "US House Election Results",
       subtitle = "The plot demonstrates the percentage of votes <strong><span style='color: #0000FF;'>Democratic</span></strong> and <strong><span style='color: #FF0000;'>Republican</span></strong> candidates received in US House elections<br> between 1976 and 2022.",
       color = "Party",
       caption = "Source: MIT Election and Data Science Lab") +
  scale_color_manual(values = c("blue", "red"), 
                     labels = c("Democrat", "Republican"), 
                     breaks = c("DEMOCRAT", "REPUBLICAN")) +
  scale_x_continuous(limits = c(1976, 2022),
                     breaks = c(1976, 1988, 2000, 2012, 2022),
                     labels = c("1976", "1988", "2000", "2012", "2022")) +
  theme(plot.title = element_markdown(size = 120, family = "title"),
        plot.subtitle = element_markdown(size = 70, lineheight = 0.01, family = "subtitle"),
        plot.caption = element_markdown(linewidth = 0.02, hjust = 0.5, size = 45, family = "caption"),
        panel.grid.major.x = element_blank(),
        panel.grid.major.y = element_line(linetype = "dotted"),
        axis.text.x = element_markdown(angle = 90, size = 35),
        axis.text.y = element_markdown(size = 35), 
        strip.text.x = element_markdown(size = 40, lineheight = 0.01, margin = margin(1,1,1,1, "pt")),
        legend.title = element_markdown(size = 65, face = "bold"),
        legend.text = element_markdown(size = 45),
        legend.direction = "vertical",
        legend.position = "none",
        legend.spacing.x = unit(0.01, "cm"),
        legend.spacing.y = unit(0.01, "cm"))



ggsave("plot.png", dpi = 720,  height = 6, width = 8)

and the output is this;

Based on this code, I do have two questions to make the plot better;

1. First,I wanted to add the percentage of votes each party received in the 2022 elections. To that end, I used the following code, geom_text(data = data_final %>% filter(year == 2022) %>% mutate(y_placement = percent, y_placement = ifelse(percent > 0.5, y_placement + 0.15, y_placement-0.15)), aes(x = year, y = y_placement, label = round(percent, 2)), size = 10, nudge_x = -2, check_overlap = TRUE). However, this code assigns the y-axis percentage if one party receives a vote share higher than 0.5. In some cases, such as Michigan, neither of the two parties receive a vote share higher than 0.5 and therefore there is only one text seen in the plot. How can I overcome this issue? Please bear in mind that, I would like to have higher vote shares placed higher and lower vote shares placed lower so that the texts should be differentiated and seen better by the audience.
2. The other issue is in some cases, for instance Democrats did not have a vote percent in North Dakota in 2022, I would like to have the last election result plotted in the graph. How can I achieve this?

Thank you for your attention and assistance beforehand.

Answer 1

Michigan

To fix states where both percents are below 0.5, instead of < 0.5 we can just rank the two numbers to determine which is above, which is below.

data_final %>%
  filter(year == 2022) %>%
  mutate(y_placement = percent, y_placement = percent + c(-0.15, 0.15)[rank(percent)]) %>%
  filter(state %in% c("Michigan", "Colorado"))
# # A tibble: 4 × 7
# # Groups:   year, state [2]
#    year state    total_votes party         vote percent y_placement
#   <dbl> <chr>          <dbl> <chr>        <dbl>   <dbl>       <dbl>
# 1  2022 Colorado     2472074 REPUBLICAN 1050960   0.425       0.275
# 2  2022 Colorado     2472074 DEMOCRAT   1365427   0.552       0.702
# 3  2022 Michigan     4375537 REPUBLICAN 2083361   0.476       0.326
# 4  2022 Michigan     4375537 DEMOCRAT   2184504   0.499       0.649

North Dakota

We can slice_max over year, grouped by c(state, party). From there, if you want the last per-party, then

ungroup(data_final) %>%
  slice_max(order_by = year, by = c(state, party)) %>%
  group_by(state) %>%
  mutate(y_placement = percent, y_placement = percent + c(-0.15, 0.15)[rank(percent)]) %>%
  filter(state %in% c("Michigan", "Colorado", "North Dakota"))
# # A tibble: 6 × 7
# # Groups:   state [3]
#    year state        total_votes party         vote percent y_placement
#   <dbl> <chr>              <dbl> <chr>        <dbl>   <dbl>       <dbl>
# 1  2022 Colorado         2472074 REPUBLICAN 1050960   0.425      0.275 
# 2  2022 Colorado         2472074 DEMOCRAT   1365427   0.552      0.702 
# 3  2022 Michigan         4375537 REPUBLICAN 2083361   0.476      0.326 
# 4  2022 Michigan         4375537 DEMOCRAT   2184504   0.499      0.649 
# 5  2022 North Dakota      238586 REPUBLICAN  148399   0.622      0.772 
# 6  2016 North Dakota      338459 DEMOCRAT     80377   0.237      0.0875

If you want the last complete year, then

data_final %>%
  filter(all(c("DEMOCRAT", "REPUBLICAN") %in% party)) %>%
  group_by(state) %>%
  filter(year == max(year)) %>%
  mutate(y_placement = percent, y_placement = percent + c(-0.15, 0.15)[rank(percent)]) %>%
  filter(state %in% c("Michigan", "Colorado", "North Dakota"))
# # A tibble: 6 × 7
# # Groups:   state [3]
#    year state        total_votes party         vote percent y_placement
#   <dbl> <chr>              <dbl> <chr>        <dbl>   <dbl>       <dbl>
# 1  2016 North Dakota      338459 REPUBLICAN  233980   0.691      0.841 
# 2  2016 North Dakota      338459 DEMOCRAT     80377   0.237      0.0875
# 3  2022 Colorado         2472074 REPUBLICAN 1050960   0.425      0.275 
# 4  2022 Colorado         2472074 DEMOCRAT   1365427   0.552      0.702 
# 5  2022 Michigan         4375537 REPUBLICAN 2083361   0.476      0.326 
# 6  2022 Michigan         4375537 DEMOCRAT   2184504   0.499      0.649