Health Funding Surges While Education Slips

Funder priorities, 2020 -> 2025

Arrow chart redesign that avoids spaghetti graphs by using directional arrows and strategic sorting to show non-profit funder priority shifts from 2020 to 2025.

Original

This month’s Storytelling with Data challenge aims to avoid the spaghetti graph. Line graphs are generally a great way to show data over time. However, when there are too many series in a single chart, it can quickly become what I refer to as a “spaghetti graph”—a tangled mess of overlapping lines that’s hard to read. How would you redesign the following visual to avoid the spaghetti graph?

Figure 1: Original chart

Additional information can be found HERE

Makeover

Figure 2: Arrow chart showing non-profit funder support changes from 2020 to 2025. Categories sorted by 2025 support level with subtle shading grouping growth (Health +8pp to 75%, Arts & Culture +23pp to 43%) versus decline (Education -13pp to 60%, Human Services -5pp to 55%, Other -23pp to 30%). Blue arrows show growth, orange show decline. Dashed line marks 2025 median at 55%.

Steps to Create this Graphic

1. Load Packages & Setup

```{r}
#| label: load

if (!require("pacman")) install.packages("pacman")
pacman::p_load(
  tidyverse,  # Easily Install and Load the 'Tidyverse'
  ggtext,     # Improved Text Rendering Support for 'ggplot2'
  showtext,   # Using Fonts More Easily in R Graphs
  janitor,    # Simple Tools for Examining and Cleaning Dirty Data
  scales,     # Scale Functions for Visualization
  glue        # Interpreted String Literals
) 

### |- figure size ---- 
camcorder::gg_record(
  dir    = here::here("temp_plots"),
  device = "png",
  width  = 8,
  height = 6,
  units  = "in",
  dpi    = 320
)

# Source utility functions
suppressMessages(source(here::here("R/utils/fonts.R")))
source(here::here("R/utils/social_icons.R"))
source(here::here("R/utils/image_utils.R"))
source(here::here("R/themes/base_theme.R"))
```

2. Read in the Data

```{r}
#| label: read

raw_data <- readxl::read_excel(
  here::here("data/SWDchallenge/2025/SWDchallenge OCT2025.xlsx"),
  range = "C7:I12") |> 
  clean_names()
```

3. Examine the Data

```{r}
#| label: examine
#| include: true
#| eval: true
#| results: 'hide'
#| warning: false

glimpse(raw_data)
```

4. Tidy Data

```{r}
#| label: tidy

arrow_data <- raw_data |>
  rename(category = x1) |>
  select(category, y2020 = x2020, y2025 = x2025) |>
  mutate(
    category = str_to_title(category),
    change = y2025 - y2020,
    change_pct = change,
    direction = if_else(change > 0, "Growth", "Decline")
  ) |>
  arrange(desc(y2025))

arrow_data <- arrow_data |>
  mutate(
    category = factor(category, levels = rev(category)),
    lab_2020 = label_percent(accuracy = 1)(y2020),
    lab_2025 = label_percent(accuracy = 1)(y2025),
    lab_delta = if_else(change >= 0,
      paste0("+", label_percent(accuracy = 1)(change)),
      label_percent(accuracy = 1)(change)
    ),
    x_mid = (y2020 + y2025) / 2,
    hjust_2020 = if_else(y2020 <= y2025, 1.15, -0.15),
    hjust_2025 = if_else(y2020 <= y2025, -0.15, 1.15)
  )

median_2025 <- median(arrow_data$y2025, na.rm = TRUE)
n_cats <- nrow(arrow_data)
max_x <- max(arrow_data$y2020, arrow_data$y2025, na.rm = TRUE)
```

5. Visualization Parameters

```{r}
#| label: params

### |-  plot aesthetics ----
colors <- get_theme_colors(
  palette = c(
    `TRUE` = "#1976D2",   
    `FALSE` = "#F57C00"
  )
)

### |-  titles and caption ----
title_text <- str_glue("Health Funding Surges While Education Slips")

subtitle_text <- str_glue(
  "Funder priorities shifted from 2020 to 2025 (sorted by current support level)\n",
  "Data self-reported by funders • Percentages exceed 100% as funders support multiple categories"
)

# Create caption
caption_text <- create_swd_caption(
  year = 2025,
  month = "Oct",
  source_text =  "Storytelling with Data: A Data Visualization Guide for Business Professionals"
)

### |-  fonts ----
setup_fonts()
fonts <- get_font_families()

### |-  plot theme ----

# Start with base theme
base_theme <- create_base_theme(colors)

# Add weekly-specific theme elements
weekly_theme <- extend_weekly_theme(
  base_theme,
  theme(
    # Text styling 
    plot.title = element_text(face = "bold", family = fonts$title, color = colors$title, size = rel(1.14), margin = margin(b = 10)),
    plot.subtitle = element_text(family = fonts$subtitle, color = colors$text, size = rel(0.78), margin = margin(b = 20)),
    
    # Axis elements
    axis.title = element_text(color = colors$text, size = rel(0.8)),
    axis.text = element_text(color = colors$text, size = rel(0.7)),
    
    # Grid elements
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(color = "grey95", linewidth = 0.1),
    

    # Legend elements
    legend.position = "plot",
    legend.title = element_text(family = fonts$text, size = rel(0.8)),
    legend.text = element_text(family = fonts$text, size = rel(0.7)),
    
    # Plot margins 
    plot.margin = margin(t = 10, r = 15, b = 10, l = 15),
  )
)

# Set theme
theme_set(weekly_theme)
```

6. Plot

```{r}
#| label: plot

p <- ggplot(arrow_data, aes(y = category)) +

  # Geoms
  geom_vline(
    xintercept = median_2025, linetype = "dashed",
    color = "gray55", linewidth = 0.25
  ) +

  # median tag
  annotate(
    "label",
    x = median_2025, y = n_cats + 0.35,
    label = paste0("2025 median: ", label_percent(accuracy = 1)(median_2025)),
    size = 3.2, fontface = "bold",
    label.size = 0, fill = "white", alpha = 0.95, color = "gray35"
  ) +

  # arrows
  geom_segment(
    aes(x = y2020, xend = y2025, yend = category, color = change > 0),
    linewidth = 1.4, lineend = "round",
    arrow = arrow(length = unit(0.28, "cm"), type = "open")
  ) +
  
  # subtle background 
  geom_rect(data = filter(arrow_data, change > 0),
            aes(ymin = as.numeric(category) - 0.25, 
                ymax = as.numeric(category) + 0.25),
            xmin = 0, xmax = 0.9, 
            fill = "gray", alpha = 0.1) +

  # arrows labels
  geom_text(aes(x = y2020, label = lab_2020, hjust = hjust_2020),
    size = 3.2, color = "gray35", fontface = "bold"
  ) +
  geom_text(aes(x = y2025, label = lab_2025, hjust = hjust_2025, color = change > 0),
    size = 3.2, fontface = "bold", show.legend = FALSE
  ) +
  geom_text(aes(x = x_mid, label = lab_delta, color = change > 0),
    vjust = -0.9, size = 3.3, fontface = "bold", show.legend = FALSE
  ) +

  # Scales
  scale_x_continuous(
    labels = label_percent(accuracy = 1),
    limits = c(0, 0.9),
    breaks = seq(0, 1, by = 0.20)
  ) +
  scale_y_discrete() +
  scale_color_manual(values = colors$palette) +
  coord_cartesian(clip = "off") +

  # Labs
  labs(
    title = title_text,
    subtitle = subtitle_text,
    x = "Percent of funders", y = NULL,
    caption = caption_text
  ) +

  # Theme
  theme(
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_line(color = "gray93", linewidth = 0.4),
    plot.title = element_text(
      size = rel(1.8),
      family = fonts$title,
      face = "bold",
      color = colors$title,
      lineheight = 1.1,
      margin = margin(t = 5, b = 5)
    ),
    plot.subtitle = element_text(
      size = rel(0.80),
      family = fonts$subtitle,
      color = alpha(colors$subtitle, 0.9),
      lineheight = 1.2,
      margin = margin(t = 5, b = 10)
    ),
    plot.caption = element_markdown(
      size = rel(0.50),
      family = fonts$caption,
      color = colors$caption,
      hjust = 0.5,
      margin = margin(t = 10)
    )
  ) 
```

7. Save

```{r}
#| label: save

### |-  plot image ----  
save_plot(
  p, 
  type = 'swd', 
  year = 2025, 
  month = 10, 
  width  = 8,
  height = 6,
  )
```

8. Session Info

TipExpand for Session Info

R version 4.4.1 (2024-06-14 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 22631)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.utf8    

time zone: America/New_York
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices datasets  utils     methods   base     

other attached packages:
 [1] here_1.0.1      glue_1.8.0      scales_1.3.0    janitor_2.2.0  
 [5] showtext_0.9-7  showtextdb_3.0  sysfonts_0.8.9  ggtext_0.1.2   
 [9] lubridate_1.9.3 forcats_1.0.0   stringr_1.5.1   dplyr_1.1.4    
[13] purrr_1.0.2     readr_2.1.5     tidyr_1.3.1     tibble_3.2.1   
[17] ggplot2_3.5.1   tidyverse_2.0.0 pacman_0.5.1   

loaded via a namespace (and not attached):
 [1] gtable_0.3.6      xfun_0.49         htmlwidgets_1.6.4 tzdb_0.5.0       
 [5] vctrs_0.6.5       tools_4.4.0       generics_0.1.3    curl_6.0.0       
 [9] gifski_1.32.0-1   fansi_1.0.6       pkgconfig_2.0.3   readxl_1.4.3     
[13] rematch_2.0.0     lifecycle_1.0.4   compiler_4.4.0    farver_2.1.2     
[17] textshaping_0.4.0 munsell_0.5.1     codetools_0.2-20  snakecase_0.11.1 
[21] htmltools_0.5.8.1 yaml_2.3.10       pillar_1.9.0      camcorder_0.1.0  
[25] magick_2.8.5      commonmark_1.9.2  tidyselect_1.2.1  digest_0.6.37    
[29] stringi_1.8.4     rsvg_2.6.1        rprojroot_2.0.4   fastmap_1.2.0    
[33] grid_4.4.0        colorspace_2.1-1  cli_3.6.4         magrittr_2.0.3   
[37] utf8_1.2.4        withr_3.0.2       timechange_0.3.0  rmarkdown_2.29   
[41] cellranger_1.1.0  ragg_1.3.3        hms_1.1.3         evaluate_1.0.1   
[45] knitr_1.49        markdown_1.13     rlang_1.1.6       gridtext_0.1.5   
[49] Rcpp_1.0.13-1     xml2_1.3.6        renv_1.0.3        svglite_2.1.3    
[53] rstudioapi_0.17.1 jsonlite_1.8.9    R6_2.5.1          systemfonts_1.1.0

9. GitHub Repository

TipExpand for GitHub Repo

The complete code for this analysis is available in swd_2025_10.qmd. For the full repository, click here.

10. References

TipExpand for References

Data Sources:

• Storytelling with Data: A Data Visualization Guide for Business Professionals, 10th Anniversary Edition : Storytelling with Data: A Data Visualization Guide for Business Professionals, 10th Anniversary Edition