In malcalakovalski/fim: Fiscal Impact Measure

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>", 
  echo = FALSE,
  fig.align = 'center',
  warning = FALSE,
  message = FALSE,
  cache = FALSE
)

knitr::opts_knit$set(root.dir = rprojroot::find_rstudio_root_file())

librarian::shelf(
  'tidyverse',
  'purrr',
  'tsibble',
  'lubridate',
  'glue',
  #'ggiraph',
  #  'plotly'
)
comparison_plot <- function(.data, variable){


  plot <- .data %>% 
    filter(variable == {{ variable }}) %>% 
    ggplot(aes(x = date,  y =  value, fill = source)) +
    #geom_col(position=position_dodge2(reverse = TRUE)) +
    geom_col(position=position_dodge2(reverse = TRUE)) +
    labs(title = glue::glue("{snakecase::to_title_case(variable)}"),
         x = NULL,
         y = NULL) +
    ggthemes::theme_hc() +
    gghutchins::scale_fill_hutchins(
      name = "",
      labels = c('Updated', 'Previous'),
      pal = 'qual',
      rev = FALSE
    ) +
    scale_x_yearquarter(breaks = waiver(),
                        date_breaks = '3 months',
                        date_labels = "Q%q") +
    facet_grid( ~ year(date),
                space = "free_x",
                scales = "free_x",
                switch = "x")  +
    theme(legend.position = 'top') +
    guides(fill = guide_legend(reverse = TRUE)) 


  variable_name <- rlang::as_name(rlang::ensym(variable))

  if(str_ends(variable_name, 'contribution')){
    plot + 
      scale_y_continuous(name = '', 
                         labels = scales::label_percent(scale = 1))
  } else {
    plot +
      scale_y_continuous(name = '', 
                         labels = scales::label_comma())
  }

}


```r
# 
# # Load previous months results
# previous <- 
#   readxl::read_xlsx('results/4-2021/fim-4-2021-without-errors.xlsx') %>% 
#   mutate(date = yearquarter(date)) %>% 
#   drop_na(date) %>% 
#   as_tsibble(index = date) %>% 
#   filter_index("2020 Q2" ~ "2023 Q1") 
#  
# # 
# current <- readxl::read_xlsx('results/5-2021/fim-5-2021.xlsx') %>% 
#   mutate(date = yearquarter(date)) %>% 
#   drop_na(date) %>% 
#   as_tsibble(index = date) %>% 
#   filter_index("2020 Q2" ~ "2023 Q1")
# 
# previous_long <- pivot_longer(previous, cols = where(is.numeric), values_to = 'previous')
# current_long <- pivot_longer(current, cols = where(is.numeric), values_to = 'current')
# 
# comparison <- inner_join(previous_long, 
#                          current_long,
#                          by = c('date', 'name', 'id')) %>% 
#   pivot_longer(c(previous, current),
#                names_to = 'source') %>% 
#   rename(variable = name)
# 
# comparison_nested <-
#   comparison %>% 
#   group_by(variable) %>% 
#   nest() %>% 
#   mutate(plot = map2(.x = variable,
#                      .y = data,
#                      .f = ~comparison_plot(.data = .y, 
#                                   variable = .x)))
# 
# 
# plots <- rlang::set_names(comparison_nested$plot, comparison_nested$variable)

Headline FIM

plots$fiscal_impact

Federal Purchases/Grants Contribution

Total Federal

plots$federal_contribution

Federal Purchases/Grants Components

plots$federal_purchases_contribution
plots$consumption_grants_contribution
plots$federal_non_health_grants_arp_contribution
plots$investment_grants_contribution

State Purchases/Grants Contribution

plots$state_contribution

State Purchases/Grants Components (State Contribution = State Purchases - CGrants - IGrants - ARP CGrants) **NOTE: IN THE CODE THAT I CURRENTLY HAVE, WE DON'T REATTRIBUTE ARP CGRANTS AWAY FROM STATES-- CONFIRMING WE SHOULD DO THIS/REMINDER TO DISCUSS?

plots$state_purchases_contribution
plots$consumption_grants_contribution
plots$federal_non_health_grants_arp_contribution
plots$investment_grants_contribution

Transfers Contributions

Total Federal

plots$federal_transfers_contribution

Federal Transfers Components

plots$federal_transfers_nonarp_contribution
plots$federal_transfers_arp_contribution

Total State

plots$state_transfers_contribution

State Transfers Components

plot$state_transfers_nonarp_contribution
plots$state_transfers_arp_contribution

Taxes Contributions

Total

plots$taxes_contribution

Components

plots$federal_taxes_contribution
plots$state_taxes_contribution

malcalakovalski/fim documentation built on July 30, 2024, 8:37 a.m.