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', 'published'),
      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())
  }

}

# Load published months results
published <- 
  readxl::read_xlsx('results/4-2021/fim-4-2021-published.xlsx') %>% 
  mutate(date = yearquarter(date)) %>% 
  drop_na(date) %>% 
  as_tsibble(index = date) %>% 
  filter_index("2020 Q2" ~ "2023 Q1") %>% 
  # rename variables so that they match new names
  rename_with(~paste0(.x, 'ribution'), ends_with("cont")) %>% 
  rename_with(~stringr::str_replace(.x, pattern = 'unemployment_insurance',
                                    replacement = 'ui'), 
              contains('unemployment_insurance')) %>% 
  rename_with(~stringr::str_replace(.x, pattern = 'nom',
                                    replacement = 'purchases'), 
              contains('nom')) %>% 
  rename_with(~stringr::str_replace(.x, pattern = 'pi',
                                    replacement = 'deflator_growth'), 
              contains('pi')) %>% 
  rename_with(~stringr::str_replace(.x, pattern = 'noncorp',
                                    replacement = 'non_corporate'), 
              contains('noncorp')) %>% 
  rename_with(~stringr::str_replace(.x, pattern = 'federal_cgrants',
                                    replacement = 'consumption_grants'), 
              contains('cgrants')) %>% 
  rename_with(~stringr::str_replace(.x, pattern = 'federal_igrants',
                                    replacement = 'investment_grants'), 
              contains('igrants')) %>% 
  rename_with(~stringr::str_replace(.x, pattern = 'state_local',
                                    replacement = 'state'), 
              contains('state_local')) %>% 

  rename(
    federal_aid_to_small_businesses_arp = aid_to_small_businesses,
    federal_non_health_grants_arp_contribution = non_health_grants_contribution
  ) %>% 
  select(-date.y)

# 
no_errors <- 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")

published_long <- pivot_longer(published, cols = where(is.numeric), values_to = 'published')
no_errors_long <- pivot_longer(no_errors, cols = where(is.numeric), values_to = 'no_errors')

comparison <- inner_join(published_long, 
                         no_errors_long,
                         by = c('date', 'name', 'id')) %>% 
  pivot_longer(c(published, no_errors),
               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)

plotly::ggplotly(plots$fiscal_impact)

plots$ui_contribution

Purchases {.tabset .tabset-pills}

Contributions

plots$federal_purchases_contribution
plots$state_purchases_contribution

Levels

plots$federal_purchases
plots$state_purchases

Grants {.tabset .tabset-pills}

Contributions

plots$consumption_grants_contribution
plots$investment_grants_contribution
plots$federal_non_health_grants_arp_contribution

Levels

plots$consumption_grants
plots$investment_grants
plots$federal_non_health_grants_arp

Taxes

Total {.tabset .tabset-pills}

Contributions

plots$federal_taxes_contribution
plots$state_taxes_contribution

Levels

#plotly::ggplotly(plots$fiscal_impact)

Corporate taxes {.tabset .tabset-pills}

Contributions

plots$federal_corporate_taxes_contribution
plots$state_corporate_taxes_contribution

Levels

plots$federal_corporate_taxes
plots$state_corporate_taxes

Non-corporate taxes {.tabset .tabset-pills}

Contributions

plots$federal_non_corporate_taxes_contribution
plots$state_non_corporate_taxes_contribution

Levels

plots$federal_non_corporate_taxes
plots$state_non_corporate_taxes

Transfers

Total {.tabset .tabset-pills}

Contributions

plots$transfers_contribution
plots$federal_transfers_contribution
plots$state_transfers_contribution

Levels

# transfers_levels
# federal_transfers_levels
# state_transfers_levels

Health Outlays {.tabset .tabset-pills}

Contributions

plots$health_outlays_contribution
plots$federal_health_outlays_contribution
plots$state_health_outlays_contribution

Levels

plots$health_outlays
plots$federal_health_outlays
plots$state_health_outlays

Subsidies {.tabset .tabset-pills}

Contributions

plots$subsidies_contribution

Levels

plots$subsidies

Unemployment Insurance {.tabset .tabset-pills}

Contributions

plots$ui_contribution
plots$federal_ui_contribution
plots$state_ui_contribution

Levels

plots$ui
plots$federal_ui
plots$state_ui

Rebate Checks {.tabset .tabset-pills}

Contribution

plots$rebate_checks_contribution
plots$rebate_checks_arp_contribution

Level

plots$rebate_checks
plots$rebate_checks_arp

Social Benefits Remainder {.tabset .tabset-pills}

Contribution

plots$federal_social_benefits_contribution
plots$state_social_benefits_contribution

Level

plots$federal_social_benefits
plots$state_social_benefits

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