In malcalakovalski/fim: Fiscal Impact Measure

knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, results = 'asis', fig.align = "center")

librarian::shelf("tidyverse",
                  "ggtext",
                  "tinytex",
                   "glue", 
                  "lubridate", 
                 "tsibble")
devtools::load_all()

fim <- 
 readr::read_rds('data/contributions.RDS') %>% 
 filter(date >= params$start & date <= params$end)

guidez <- guides(
  fill = guide_legend(
    keywidth = unit(0.8, "cm"),
    keyheight = unit(0.4, "cm"),
    ncol = 1
  ),
  colour = guide_legend(
    keywidth = unit(0.8, "cm"),
    keyheight = unit(0.05, "cm"),
    ncol = 1
  )
)

headline <-
  fim %>%
  select(date, fiscal_impact, fiscal_impact_moving_average) %>%
  pivot_longer(fiscal_impact) 

recessions <-
  recessions %>% 
  mutate_where(recession_start == yearquarter("2019 Q4"),
               recession_start = yearquarter("2020 Q1"),
               recession_end = yearquarter("2020 Q2"))

projection_start <-
  fim %>% 
  filter(id == 'projection') %>%
  slice(1) %>%
  pull(date)

headline_plot <-
  ggplot(data = headline) +
    geom_rect(data = recessions %>% 
            filter(recession_start > params$start),
            aes(xmin = recession_start, 
              xmax = recession_end, 
              ymin=-Inf,
              ymax=+Inf),
              fill = 'grey',
              alpha = 0.5) +
  geom_col(aes(x = date, y = value, fill = name),
           width = 50) +
  geom_line(aes(x = date, 
                y = fiscal_impact_moving_average,
                colour = "4-quarter moving-average")) +
  geom_point(aes(x = date,
                 y = fiscal_impact_moving_average,
                 colour = "4-quarter moving-average"),
             size = 1) +
  ggtext::geom_richtext(aes(x = yearquarter(today()) + 4,
                            y = 16),
                        label = "Projection",
                        cex = 2,
                        fill = NA, 
                        label.color = NA) +
  scale_x_yearquarter(expand = expansion()) +
  fim::scale_fill_fim(palette = 'headline',
                 labels = " Quarterly fiscal impact")  +
  scale_color_manual(" ",
                     values = c("4-quarter moving-average" = "black")) +

  annotate("rect", xmin = projection_start, xmax = yearquarter(params$end),
           ymin = -Inf, ymax = Inf, alpha = 0.2, fill = 'yellow') +
  guides(fill = guide_legend(keywidth = unit(0.8, "cm"),
                             keyheight = unit(0.4, "cm"),
                             ncol = 1),
         colour = guide_legend(keywidth = unit(0.8, "cm"),
         keyheight = unit(0.05, "cm"),
         ncol = 1)) +
  fim::fim_theme() +
  guides(fill = guide_legend(keywidth = unit(0.8, "cm"),
                             keyheight = unit(0.4, "cm"),
                             ncol = 1),
  colour = guide_legend(
    keywidth = unit(0.8, "cm"),
    keyheight = unit(0.05, "cm"),
    ncol = 1
  ))+
  labs(title = glue("**Hutchins Center Fiscal Impact Measure: Total**"),
       x = NULL,
       y = NULL,
       subtitle = "Fiscal Policy Contribution to Real GDP Growth, percentage points",
       caption = "Source: Hutchins Center calculations from Bureau of Economic Analysis 
        and Congressional Budget Office data; grey shaded areas indicate recessions 
        and yellow shaded areas indicate projection.") 
headline_plot 

#knitr::include_graphics(path = 'images/HC_NEW_BROOKINGS_RGB.jpg', error = FALSE)
knitr::include_graphics('images/HC_NEW_BROOKINGS_RGB.jpg')

projection_start <- 
  fim %>% 
  dplyr::filter(id == 'projection') %>%
  slice(1) %>%
  pull(date)

expanded <-
  fim %>%
  summarise(
    date,
    federal_contribution,
    state_contribution,
    taxes_transfers_contribution = transfers_contribution + federal_corporate_taxes_contribution +
      federal_non_corporate_taxes_contribution + state_corporate_taxes_contribution + state_non_corporate_taxes_contribution,
    fiscal_impact_moving_average
  ) %>%
  pivot_longer(cols = ends_with('contribution'),
               names_to = 'variable')


  ggplot(data = expanded) +
     geom_rect(data = recessions %>% 
            filter(recession_start > params$start),
            aes(xmin = recession_start, 
              xmax = recession_end, 
              ymin=-Inf,
              ymax=+Inf),
              fill = 'grey',
              alpha = 0.5) +
      geom_col(aes(x = date, y = value, fill = variable),
               width = 50) +
      geom_line(aes(x = date,
                    y = fiscal_impact_moving_average,
                    colour = "4-quarter moving-average")) +
      geom_point(aes(x = date,
                     y = fiscal_impact_moving_average,
                     colour = "4-quarter moving-average"),
                size = 1) +
      geom_richtext(aes(x = yearquarter(today()) + 4,
                        y = 16), 
                    label = "Projection",
                    cex = 2, 
                    fill = NA, label.color = NA, # remove background and outline
      ) +

  scale_x_yearquarter(expand = expansion()) +

      scale_fill_fim(palette = 'expanded',
                     labels = c(" Federal Purchases",
                              " State & Local Purchases",
                              " Taxes, Transfers, & Subsidies")) +
     scale_color_manual(" ", 
                        values=c("4-quarter moving-average" ="black")) +
      annotate("rect", xmin = projection_start, xmax = yearquarter(params$end),
               ymin = -Inf, ymax = Inf, alpha = 0.2, fill = 'yellow') +
      # scale_x_yearquarter(breaks = 0, date_breaks = "2 years", date_labels = '%Y Q%q',
      #              expand = c(0,0)) + 

   guides(
  fill = guide_legend(
    keywidth = unit(0.8, "cm"),
    keyheight = unit(0.4, "cm"),
    ncol = 1
  ),
  colour = guide_legend(
    keywidth = unit(0.8, "cm"),
    keyheight = unit(0.05, "cm"),
    ncol = 1
  )
) +
        fim::fim_theme() +
         labs(title = glue("**Hutchins Center Fiscal Impact Measure: Components**"),
       x = NULL,
       y = NULL,
       subtitle = "Fiscal Policy Contribution to Real GDP Growth, percentage points",
       caption = "Source: Hutchins Center calculations from Bureau of Economic Analysis 
        and Congressional Budget Office data; grey shaded areas indicate recessions 
        and yellow shaded areas indicate projection.") 

template <- 
  list(
      geom_col(aes(x = date, y = value, fill = variable),
               width = 50),
      geom_line(aes(x = date,
                    y = fiscal_impact_moving_average,
                    colour = "4-quarter moving-average")),
      geom_point(aes(x = date,
                     y = fiscal_impact_moving_average,
                     colour = "4-quarter moving-average"),
                size = 1),
      geom_richtext(aes(x = yearquarter(today()) + 1,
                        y = 16), 
                    label = "Projection",
                    cex = 2, 
                    fill = NA, label.color = NA, # remove background and outline
      ),
      geom_rect(data = fim::recessions %>% 
            filter(recession_start > params$start),
            aes(xmin = recession_start, 
              xmax = recession_end, 
              ymin=-Inf,
              ymax=+Inf),
              fill = 'grey',
              alpha = 0.2),

     scale_color_manual(" ", 
                        values=c("4-quarter moving-average" ="black")) ,
      annotate("rect", xmin = projection_start, xmax = yearquarter(params$end),
               ymin = -Inf, ymax = Inf, alpha = 0.1, fill = 'yellow'),
      # scale_x_yearquarter(breaks = 0, date_breaks = "2 years", date_labels = '%Y Q%q',
      #              expand = c(0,0)) , 

   guides(
  fill = guide_legend(
    keywidth = unit(0.8, "cm"),
    keyheight = unit(0.4, "cm"),
    ncol = 1
  ),
  colour = guide_legend(
    keywidth = unit(0.8, "cm"),
    keyheight = unit(0.05, "cm"),
    ncol = 1
  )
),
        fim::fim_theme(),
         labs(title = glue("**Hutchins Center Fiscal Impact Measure: Components**"),
       x = NULL,
       y = NULL,
       subtitle = "Fiscal Policy Contribution to Real GDP Growth, percentage points",
       caption = "Source: Hutchins Center calculations from Bureau of Economic Analysis 
        and Congressional Budget Office data; grey shaded areas indicate recessions 
        and yellow shaded areas indicate projection.") 
)

ggplot(expanded) +
  template +
        scale_fill_fim(palette = 'expanded',
                     labels = c(" Federal Purchases",
                              " State & Local Purchases",
                              " Taxes, Transfers, & Subsidies"))

#knitr::include_graphics(path = 'images/HC_NEW_BROOKINGS_RGB.jpg', error = FALSE)
knitr::include_graphics('images/HC_NEW_BROOKINGS_RGB.jpg')

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