Visualizing Pell Grant Awards in the U.S. in 2017

Exploring Colorado trends and the overall state-level Pell grant distribution
R
#TidyTuesday
line-plot
gt
Author

Mickey Rafa

Published

December 30, 2022

Figure 1: Line plot depicting the minimum and maximum annual Pell grant awards each year in Colorado (1999-2017).
Figure 2: Table showing the distribution of annual awards of Pell grants by U.S. state/territory in 2017.

1. Load Packages & Setup

Show code
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
    tidyverse,
    tidytuesdayR,
    dlookr,
    ggtext,
    gt,
    gtExtras,  #for font awesome icons in gt tables
    ggbump,
    showtext,
    janitor,   #for clean_names()
    scales,
    htmltools, #for tagList()
    glue,
    epoxy,
    here,
    geomtextpath
)    

font_add('fa-brands', 'fonts/Font Awesome 6 Brands-Regular-400.otf')
sysfonts::font_add_google("Lato","lato")
showtext::showtext_auto()

2. Read in the Data

Show code
tt_year <- 2022
tt_week <- 35

tuesdata <- tidytuesdayR::tt_load(tt_year, week = tt_week)

df <- tuesdata$pell %>% 
  clean_names()

3. Examine the Data

Show code
df %>%
  glimpse()
Rows: 100,474
Columns: 6
$ state     <chr> "AK", "AK", "AK", "AK", "AK", "AK", "AL", "AL", "AL", "AL", …
$ award     <dbl> 197232.9, 133148.0, 107287.0, 3425148.8, 2441864.0, 353170.0…
$ recipient <dbl> 109, 69, 72, 1920, 1256, 221, 2369, 837, 3236, 854, 2842, 16…
$ name      <chr> "Alaska Pacific University", "Alaska Vocational Technical Ce…
$ session   <chr> "1999-00", "1999-00", "1999-00", "1999-00", "1999-00", "1999…
$ year      <dbl> 1999, 1999, 1999, 1999, 1999, 1999, 1999, 1999, 1999, 1999, …

4. Tidy the Data

Show code
df_colorado <- df %>% 
  filter(state == 'CO') %>% 
  mutate(award_per_recipent = award / recipient)

df_colorado_min <- df_colorado %>% 
  filter(recipient >= 10) %>% 
  group_by(year) %>% 
  slice_min(award_per_recipent) %>% 
  mutate(min_max_label = 'Min')

df_colorado_max <- df_colorado %>% 
  filter(recipient >= 10) %>% 
  group_by(year) %>% 
  slice_max(award_per_recipent) %>% 
  mutate(min_max_label = 'Max')

df_colorado_min_max <- bind_rows(df_colorado_min, df_colorado_max)
Show code
df_tbl <- df %>% 
  slice_max(year) %>% 
  group_by(state) %>% 
  summarise(sum_award = sum(award, na.rm = TRUE),
            sum_recipients = sum(recipient, na.rm = TRUE)) %>% 
  ungroup() %>% 
  mutate(award_per_recipient = sum_award / sum_recipients) %>% 
  arrange(-award_per_recipient)

5. Visualization Parameters

Show code
my_theme <- theme(
  text = element_text(family = 'Lato', size=14, color='black'), 
  # plot.title = element_textbox_simple(color="black", face="bold", size=20, hjust=0), 
  # plot.subtitle = element_textbox_simple(color="black", size=12, hjust=0), 
  #axis.title = element_blank(), 
  #axis.text = element_blank(), 
  axis.ticks = element_blank(),
  #axis.line = element_blank(), 
  # plot.caption = element_textbox_simple(color="black", size=12), 
  panel.background =  element_blank(), 
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  panel.border = element_blank(), 
  legend.position = 'none')

txt <- 'black'
twitter <- glue("<span style='font-family:fa-brands; color:{txt}'>&#xf099;</span>")
github <- glue("<span style='font-family:fa-brands; color:{txt}'>&#xf09b;</span>")
space <- glue("<span style='color:black;font-size:1px'>'</span>")

viz_colors <- c('Max' = '#645A7B', 'Min' = '#6ED187')

title_text <- 'Pell Grant Award Value per Recipient'
subtitle_text <- glue("<span style='color:#6ED187'>Min</span> and <span style='color:#645A7B'>Max</span> values each year in Colorado")
caption_text <- glue("Tidy Tuesday Week 35 (2022)<br>{twitter} @mickey.rafa • {github} mrafa3")

max_value <- df_colorado_min_max %>% 
  filter(year == 2010,
         min_max_label == 'Max') %>% 
  pull(award_per_recipent)

6. Plot

What is the overall trend in Pell grant awards in Colorado?

Show code
viz_pell_colorado <- df_colorado_min_max %>% 
  ggplot(.,
         aes(x=year,
             y=award_per_recipent,
             color=min_max_label)) + 
  geom_point(size=1) + 
  geom_line() + 
  ggforce::geom_mark_circle(aes(filter = year == 2010 & min_max_label == 'Max', 
                                label = name,
                                description = epoxy("Peak value of {.dollar round(max_value, 0)} in 2010")),
                            label.family = 'Lato',
                            label.fontsize = c(20, 13)) + 
  labs(x='',
       y='',
       title = title_text,
       subtitle = subtitle_text,
       caption = caption_text) + 
  scale_y_continuous(labels = c('', '$2,000', '$4,000', '$6,000', ''),
                     limits = c(0,8000)) + 
  scale_color_manual(values = viz_colors) + 
  my_theme + 
  theme(plot.title = element_textbox(size=rel(4), face='bold'),
        plot.subtitle = element_textbox(size=rel(2.1)),
        plot.caption = element_textbox(size=rel(1.5), lineheight=.3),
        axis.text = element_text(size=rel(1.5)))

Which state has the highest pell award per student?

Show code
tbl_viz <- df_tbl %>% 
  arrange(-sum_award) %>% 
  gt() %>% 
  gt::cols_label(state = 'State',
                 sum_award = 'Total Pell $',
                 sum_recipients = 'Total Pell Recipients',
                 award_per_recipient = 'Avg Pell Award $') %>% 
  tab_header(title = md("**Pell Grant Awards in 2017**"),
             subtitle = md("Schools in **New Hampshire** and **Puero Rico** average the lowest and highest average awards respectively")) %>% 
  tab_source_note(source_note = "Data from Tidy Tuesday Week 35 (2022)") %>% 
  fmt_currency(columns = c(sum_award, award_per_recipient), 
               decimals = 0) %>% 
  fmt_number(columns = c(sum_recipients), 
               decimals = 0) %>% 
  gt_highlight_rows(
    rows = c(10,39), 
    fill = "lightgrey",
    bold_target_only = TRUE,
    target_col = state
    ) %>% 
  gt_hulk_col_numeric(award_per_recipient) %>% 
  tab_style(
    locations = cells_column_labels(columns = everything()),
    style = list(
      #thick border
      cell_borders(sides = "bottom", weight = px(3)),
      #make text bold
      cell_text(weight = "bold")
    )
  ) %>% 
  #apply different style to title
  tab_style(locations = cells_title(groups = "title"),
            style = list(
              cell_text(weight = "bold", size = 24)
            )) %>% 
  opt_all_caps() %>% 
  opt_table_font(
    font = list(
      google_font("Nunito Sans"),
      default_fonts()
    )
  ) %>% 
  tab_options(
    #remove border between column headers and title
    column_labels.border.top.width = px(3),
    column_labels.border.top.color = "transparent",
    #remove border around the table
    table.border.top.color = "transparent",
    table.border.bottom.color = "transparent",
    #adjust font sizes and alignment
    source_notes.font.size = 12,
    heading.align = "left"
  )

7. Save

Show code
# Save the plot as PNG
ggsave(
  filename = glue("tt_{tt_year}_{tt_week}.png"),
  plot = viz_pell_colorado,
  width = 5, height = 3.5, units = "in", dpi = 320
)

tbl_viz %>% 
  gtsave(
    filename = glue("tt_{tt_year}_{tt_week}_tbl.png"),
    path = here::here()
    )

# make thumbnail for page
magick::image_read(glue("tt_{tt_year}_{tt_week}.png")) %>%
  magick::image_resize(geometry = "400") %>%
  magick::image_write(glue("tt_{tt_year}_{tt_week}_thumbnail.png"))

8. Session Info

R version 4.4.0 (2024-04-24)
Platform: aarch64-apple-darwin20
Running under: macOS Sonoma 14.6.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: America/Denver
tzcode source: internal

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

other attached packages:
 [1] geomtextpath_0.1.4 here_1.0.1         epoxy_1.0.0        glue_1.8.0        
 [5] htmltools_0.5.8.1  scales_1.3.0       janitor_2.2.0      showtext_0.9-7    
 [9] showtextdb_3.0     sysfonts_0.8.9     ggbump_0.1.0       gtExtras_0.5.0    
[13] gt_0.11.1          ggtext_0.1.2       dlookr_0.6.3       tidytuesdayR_1.1.2
[17] lubridate_1.9.3    forcats_1.0.0      stringr_1.5.1      dplyr_1.1.4       
[21] purrr_1.0.2        readr_2.1.5        tidyr_1.3.1        tibble_3.2.1      
[25] ggplot2_3.5.1      tidyverse_2.0.0    pacman_0.5.1      

loaded via a namespace (and not attached):
 [1] gridExtra_2.3           httr2_1.0.5             rematch2_2.1.2         
 [4] rlang_1.1.4             magrittr_2.0.3          hrbrthemes_0.8.7       
 [7] snakecase_0.11.1        compiler_4.4.0          systemfonts_1.1.0      
[10] vctrs_0.6.5             pkgconfig_2.0.3         crayon_1.5.3           
[13] fastmap_1.2.0           magick_2.8.5            labeling_0.4.3         
[16] fontawesome_0.5.2       utf8_1.2.4              promises_1.3.0         
[19] rmarkdown_2.28          markdown_1.13           tzdb_0.4.0             
[22] ps_1.8.0                ragg_1.3.3              bit_4.5.0              
[25] xfun_0.48               jsonlite_1.8.9          later_1.3.2            
[28] tweenr_2.0.3            parallel_4.4.0          R6_2.5.1               
[31] stringi_1.8.4           pagedown_0.21           extrafontdb_1.0        
[34] Rcpp_1.0.13             knitr_1.48              base64enc_0.1-3        
[37] extrafont_0.19          gitcreds_0.1.2          httpuv_1.6.15          
[40] timechange_0.3.0        tidyselect_1.2.1        rstudioapi_0.17.1      
[43] yaml_2.3.10             websocket_1.4.2         processx_3.8.4         
[46] curl_5.2.3              shiny_1.9.1             withr_3.0.1            
[49] and_0.1.5               evaluate_1.0.1          polyclip_1.10-7        
[52] xml2_1.3.6              pillar_1.9.0            generics_0.1.3         
[55] vroom_1.6.5             rprojroot_2.0.4         chromote_0.3.1         
[58] paletteer_1.6.0         hms_1.1.3               commonmark_1.9.2       
[61] munsell_0.5.1           xtable_1.8-4            gdtools_0.4.0          
[64] webshot2_0.1.1          tools_4.4.0             reactable_0.4.4        
[67] fs_1.6.4                grid_4.4.0              Rttf2pt1_1.3.12        
[70] gh_1.4.1                colorspace_2.1-1        ggforce_0.4.2          
[73] cli_3.6.3               rappdirs_0.3.3          kableExtra_1.4.0       
[76] textshaping_0.4.0       fontBitstreamVera_0.1.1 fansi_1.0.6            
[79] viridisLite_0.4.2       svglite_2.1.3           gtable_0.3.5           
[82] sass_0.4.9              digest_0.6.37           fontquiver_0.2.1       
[85] htmlwidgets_1.6.4       farver_2.1.2            lifecycle_1.0.4        
[88] mime_0.12               fontLiberation_0.1.0    gridtext_0.1.5         
[91] bit64_4.5.2             MASS_7.3-61

9. Github Repository