Visualizations for Scenario 1

Map of New Infections by County

# map of new infections by county

ca_counties <- map_data("county") %>%
  filter(region == "california")

stratified_rate_infections_lower <- stratified_rate_infections %>%
  mutate(county = str_to_lower(county))

map_data <- ca_counties %>%
  left_join(stratified_rate_infections_lower, by = c("subregion" = "county"))

# map

long_caption <- "The map shows that Imperial County has the highest new infections in 2023. It appears that the coastal counties may have a lower rate of new infections."
wrapped_caption <- str_wrap(long_caption, width = 50) 

       

ggplot(map_data, aes(long, lat, group = group, fill = new_infections_per_capita)) +
  geom_polygon(color = "white") +
  scale_fill_viridis_c(option = "magma", limits = c(0,50), na.value = "grey") +
  labs(title = "Heat Map of New Infections per Capita by County, 2023", fill = "Infection Rate", caption = wrapped_caption) +
  theme_void() + 
  theme(
  plot.title = element_text(hjust = 0.5, margin = margin(b = 10)),
  legend.position = "right",
  legend.title = element_text(size = 10),
  legend.text = element_text(size = 8),
  plot.margin = margin(t = 20, r = 20, b = 20, l = 20)
)

Table of New Infections Per Capita per Race and Ethnic Group in each County

#Reformatting df for Table 

race_infections_clean <- stratified_rate_infections %>%
  pivot_wider(
    id_cols = county,
    names_from = race_ethnicity,
    values_from = c("new_infections_per_capita", "pop")
  )

#Renaming columns 

colnames(race_infections_clean) <- c("County", "American Indian or Alaska Native (Non-Hispanic)", "Asian (Non-Hispanic)", "Black (Non-Hispanic)", "Hispanic (Any Race)", "Multiracial (Two or More of Above Races)", "Native Hawaiian or Pacific Islander (Non-Hispanic)", "White (Non-Hispanic)", "American Indian or Alaska Native (Non-Hispanic) Pop", "Asian (Non-Hispanic) Pop",  "Black (Non-Hispanic) Pop", "Hispanic (Any Race) Pop", "Multiracial (Two or More of Above Races) Pop", "Native Hawaiian or Pacific Islander (Non-Hispanic) Pop", "White (Non-Hispanic) Pop")

#Adding Total per Capita for each Race/Ethnic Group Category

race_group <- c(
  "American Indian or Alaska Native (Non-Hispanic)",
  "Asian (Non-Hispanic)",
  "Black (Non-Hispanic)",
  "Hispanic (Any Race)",
  "Multiracial (Two or More of Above Races)",
  "Native Hawaiian or Pacific Islander (Non-Hispanic)",
  "White (Non-Hispanic)"
)

race_sum <- race_infections_clean %>%
  summarise(across(all_of(race_group), ~ sum(.x, na.rm = TRUE))) %>%
  mutate(County = "Total per each Race/Ethnic Group")

race_infections_clean <- bind_rows(race_infections_clean, race_sum)

#Rearranging and Select the columns 

race_infections_table <- race_infections_clean %>%
  select(County, `American Indian or Alaska Native (Non-Hispanic)`, `Asian (Non-Hispanic)`, `Black (Non-Hispanic)`, `Hispanic (Any Race)`, `Multiracial (Two or More of Above Races)`, `Native Hawaiian or Pacific Islander (Non-Hispanic)`, `White (Non-Hispanic)`
)

#Creating Table Visualization with DT Package

#Adding Bolded Values and Color
datatable(race_infections_table,
          options = list(
            pageLength = 15,
            scrollX = TRUE,
            autoWidth = TRUE),
          caption = "Rate of Infections per Capita by Race and Ethnic Group per County") %>%
  formatRound(columns = 2:ncol(race_infections_table), digits = 2) %>%
  formatStyle(1, color = "darkgreen") %>%
  formatStyle(
    columns = c(2, 8),  
    valueColumns = 0,        
    target = "cell",  
    fontWeight = styleEqual(13, "bold"),
    color = styleEqual(13, "red"))
## Table Description: "American Indian or Alaska Native (Non-Hispanic) and White (Non-Hispanic) racial and ethnic groups have the highest per capita rates of new infections in total in California. Specifically, the highest per capita rates of new infections for these racial and ethnic groups are in Imperial County. "