Graph Challenge 9

The {plotly} package lets you turn your ggplot figures into interactive ones. You can learn more about it here: https://plotly.com/ggplot2/

For this graph challenge, I want you to create an interactive plot with the April 2025 DU survey data using ggplot and plotly. The type of plot is up to you. So is the variable or variables you’d like to show.

When you’re done, rather than hitting the “render” button, hit the “publish” button to publish your submission to RPubs. Then, submit the link to your publication on Canvas.

# Load required libraries
library(googlesheets4)
library(tidyverse)
library(plotly)
library(scales)
library(viridis)

Trump’s Approval Rate by Political Affiliation at Denison University

This interactive visualization clearly shows the political divide at Denison University regarding Trump’s job approval. The pattern is striking: Democrats at all levels (Strong, Regular, and Lean) overwhelmingly disapprove of Trump, with Strong Democrats showing 100% disapproval. In contrast, Republicans generally approve, with Strong Republicans showing 100% approval and Regular Republicans at about 55% approval. Independents lean toward disapproval but show some division. The interactive hover feature reveals exact percentages for each group, demonstrating how political affiliation strongly predicts views on Trump’s performance among Denison students.

# Read in data
url <- "https://docs.google.com/spreadsheets/d/1npon5F_Gr40HQj8KVeHq_un7SOep4dzc6kjP0px7nLo/edit?usp=sharing"
gs4_deauth()
dt <- range_speedread(url)

# Create an interactive visualization showing political party affiliation vs approval of Trump
# Q3 is party affiliation, Q4 is Trump approval
dt_clean <- dt %>%
  mutate(
    party = case_when(
      Q3 == 1 ~ "Strong Democrat",
      Q3 == 2 ~ "Democrat",
      Q3 == 3 ~ "Lean Democrat",
      Q3 == 4 ~ "Independent",
      Q3 == 5 ~ "Lean Republican",
      Q3 == 6 ~ "Republican",
      Q3 == 7 ~ "Strong Republican",
      Q3 == 8 ~ "Other",
      TRUE ~ NA_character_
    ),
    trump_approval = case_when(
      Q4 == 1 ~ "Approve",
      Q4 == 2 ~ "Disapprove",
      TRUE ~ NA_character_
    )
  ) %>%
  filter(!is.na(party) & !is.na(trump_approval)) %>%
  count(party, trump_approval) %>%
  group_by(party) %>%
  mutate(percentage = n/sum(n) * 100) %>%
  ungroup() %>%
  mutate(party = factor(party, levels = c("Strong Democrat", "Democrat", "Lean Democrat",
                                         "Independent", "Lean Republican", "Republican", 
                                         "Strong Republican", "Other")))

# Create the plot
p <- ggplot(dt_clean, aes(x = party, y = percentage, fill = trump_approval, 
                          text = paste("Party:", party,
                                     "<br>Opinion:", trump_approval,
                                     "<br>Percentage:", round(percentage, 1), "%",
                                     "<br>Count:", n))) +
  geom_bar(stat = "identity", position = "stack") +
  scale_fill_manual(values = c("#E41A1C", "#377EB8")) +
  scale_y_continuous(labels = function(x) paste0(x, "%")) +
  coord_flip() +
  labs(title = "Trump Views by Party at Denison",
       subtitle = "Student views on President Trump's job performance",
       x = "",
       y = "Percentage of Respondents",
       fill = "Trump Approval",
       caption = "Source: DU Survey April 2025") +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 20, face = "bold", hjust = 0.5),
    plot.subtitle = element_text(size = 14, hjust = 0.5, margin = margin(b = 20)),
    axis.text = element_text(size = 12),
    axis.title = element_text(size = 14, face = "bold"),
    legend.position = "bottom",
    legend.title = element_text(face = "bold"),
    panel.grid.minor = element_blank(),
    plot.margin = margin(20, 20, 20, 20)
  )

# Convert to interactive plotly
interactive_plot <- ggplotly(p, tooltip = "text") %>%
  layout(
    margin = list(t = 100, b = 150, l = 20, r = 20), 
    hoverlabel = list(bgcolor = "white", font = list(size = 14)),
    legend = list(
      orientation = "h", 
      y = -0.3, 
      x = 0.5,
      xanchor = "center",
      title = list(text = "Trump Approval", font = list(size = 16)),
      itemsizing = "constant",
      itemwidth = 120,  
      tracegroupgap = 60,  
      font = list(size = 14)
    ),
    xaxis = list(
      title = list(
        text = "Percentage of Respondents", 
        standoff = 30,  # More space from axis
        font = list(size = 16)
      )
    )
  )

interactive_plot