R/obtn_tables.R

# # Load libraries
# library(gt)
# library(obtn)
# library(tidyverse)
# library(here)
# library(ragg)
# library(tinter)
# library(glue)
# library(magick)
#
#
#
# create_indicator_tables <- function(measure_input, year_input = 2020, source_note = "") {
#
#   # Table colours
#   table_palette <- c(
#     tinter("#b5cb8d", adjust = 0.8, steps = 1),
#     tinter("#0c5c4c", adjust = 0.8, steps = 1),
#     "#0c5c4c"
#   )
#
#   no_percent <- c(
#     "Total Population",
#     "Life Expectancy - Overall",
#     "Land Area",
#     "Foster Care",
#     "Index Crime",
#     "Letter Sounds",
#     "Job Growth",
#     "Childcare Availability",
#     "Mobile Homes",
#     "Vehicle Miles Traveled"
#   )
#
#   percent_formats <- c(
#     "Rural Population",
#     "Public Lands",
#     "Developed or Cultivated Land",
#     "Food Insecurity",
#     "Child Poverty",
#     "Voter Participation",
#     "3rd Grade ELA",
#     "9th Grade on Track",
#     "Graduation Rate",
#     "4yr Degree or Greater",
#     "Unemployment Rate",
#     "Low Weight Births",
#     "Vaccination Rate 2yr olds",
#     "Good Physical Health",
#     "Good Mental Health",
#     "Tobacco Use",
#     "Broadband Access",
#     "Transit Service"
#   )
#
#   dollar_formats <- c(
#     "Median Income",
#     "Property Tax per Person",
#     "Rent Costs"
#   )
#
#   # Manipulate data
#   indicator_data <-
#     obtn_data_by_measure %>%
#     filter(measure == measure_input) %>%
#     filter(year == year_input) %>%
#     select(County = geography, Amount = value) %>%
#     arrange(desc(Amount), County) %>%
#     mutate(
#       Rank = dense_rank(-Amount),
#       Rank = ifelse(County=="Oregon", "", Rank)
#     ) %>%
#     relocate(Rank, everything())
#
#   if (measure_input %in% percent_formats) {
#
#     indicator_gt <-
#       gt(indicator_data) %>%
#       fmt_percent(
#         columns = "Amount",
#         decimals = 1,
#         scale_values = FALSE
#       )
#
#   } else if (measure_input %in% dollar_formats) {
#
#     indicator_gt <-
#       gt(indicator_data) %>%
#       fmt_currency(
#         columns = "Amount",
#         decimals = 0
#       )
#
#   } else {
#
#     indicator_gt <-
#       gt(indicator_data) %>%
#       fmt_number(
#         columns = "Amount",
#         decimals = 0
#       )
#   }
#
#   # create table using {gt}
#   indicator_gt <-
#     indicator_gt %>%
#     # Align Rank column to the right
#     cols_align(
#       align = "right",
#       columns = vars(Rank)
#     ) %>%
#     # All columns with font ProximaNova
#     tab_style(
#       style = list(
#         cell_text(font = "ProximaNova-Regular", size = px(12))
#       ),
#       locations = cells_body(columns = everything())
#     ) %>%
#     # Every other row with light green
#     tab_style(
#       style = list(
#         cell_fill(color = tinter(table_palette[1], adjust = 0.2, steps = 1)),
#         cell_text(font = "ProximaNova-Regular")
#       ),
#       locations = cells_body(rows = seq(1, length(Amount), by = 2))
#     ) %>%
#     # Oregon rows with dark green, bold, and italic
#     tab_style(
#       style = list(
#         cell_fill(color = table_palette[2]),
#         cell_text(style = "italic", weight = "bold", font = "ProximaNova-Regular")
#       ),
#       locations = cells_body(rows = County %in% c("Oregon", "Urban Oregon", "Rural Oregon"))
#     ) %>%
#     # Column headers: dark green, white bold font
#     tab_style(
#       style = list(
#         cell_fill(color = table_palette[3]),
#         cell_text(color = "white", weight = "bold", font = "ProximaNova-Regular", size = px(12))
#       ),
#       locations = cells_column_labels(columns = everything())
#     ) %>%
#     # Remove grey cell borders
#     tab_style(
#       style = list(cell_borders(weight = NULL)),
#       locations = list(cells_body(columns = gt::everything()))
#     ) %>%
#     # Add source note footer
#     tab_source_note(
#       source_note = md(glue("*{source_note}*"))
#     ) %>%
#     tab_options(
#       table.width = px(172.8),     # 172.8 px = approx 1.8 inches
#       data_row.padding = px(5.3376/2),
#
#       #Remove border between column headers and title
#       column_labels.border.top.width = px(1),
#       column_labels.border.bottom.width = px(1),
#       column_labels.border.top.color = "transparent",
#       column_labels.border.bottom.color = table_palette[3],
#       table_body.border.top.style = "none",
#       table_body.border.bottom.style = "none",
#
#       #Remove border around table
#       table.border.top.color = "transparent",
#       table.border.bottom.color = "transparent",
#       source_notes.border.bottom.color = "transparent",
#       source_notes.font.size = px(12)
#     ) %>%
#     cols_width(
#       vars(Rank) ~ px(37.152),
#       vars(County) ~ px(84.096),
#       vars(Amount)~ px(51.264)
#     )
#
#   file_name <- glue("indicator_table_{str_replace(measure_input, ' ', '_')}_{year_input}.png")
#
#   # save table as PDF
#   gtsave(indicator_gt, here("inst", "plots", "tests", file_name), zoom = 20)
#
#   return(indicator_gt)
#
# }
#
# create_indicator_tables(measure_input = "Food Insecurity", year_input = 2020, source_note = "Source: Feeding America, Map the Meal Gap, 2017, updated annually. Released 2019.")
#
# #Missing:
# #net migration
# #Household in financial hardship
# #Labour force participation rate
# #Vehicle Miles Traveled(total/per capita)
#
# #tab_1 <-
#   exibble %>%
#   gt() %>%
#   tab_options(
#     table.width = pct(20)
#   ) %>%
#   gtsave("test.png")
rfortherestofus/obtn documentation built on Feb. 10, 2025, 1:30 a.m.