Terminal

Sys.setenv("connect api key here")

script.R

#' ---
#' title: "R script file"
#' ---

library(httr2)
library(jsonlite)
library(dplyr)
1library(pins)
library(tidyr)
library(purrr)
library(lubridate)
library(stringr)

2# Environment variables

bls_key <- Sys.getenv("BLS_KEY")
connect_server <- Sys.getenv("CONNECT_SERVER")
connect_api_key <- Sys.getenv("CONNECT_API_KEY")

3# BLS tables

table_ids <- c(
  "CUUR0000SA0",
  "CUUR0000SA0L1E",
  "CUUR0000SAF1",
  "CUUR0000SA0E",
  "CUUR0000SETB01",
  "CUUR0000SAM",
  "CUUR0000SEMC01",
  "CUUR0000SEMD01",
  "CUUR0000SEMF01",
  "CUUR0000SAH1"
)

id_to_label <- c(
  "CUUR0000SA0" = "All groups CPI",
  "CUUR0000SA0L1E" = "All items less food and energy",
  "CUUR0000SAF1" = "Food",
  "CUUR0000SA0E" = "Energy",
  "CUUR0000SETB01" = "Gasoline",
  "CUUR0000SAM" = "Medical care",
  "CUUR0000SEMC01" = "Physicians' services",
  "CUUR0000SEMD01" = "Hospital services",
  "CUUR0000SEMF01" = "Prescription drugs",
  "CUUR0000SAH1" = "Shelter"
)

4# Pull BLS API data

get_bls_data <- function(parameters) {
  response <- request("https://api.bls.gov/publicAPI/v2/timeseries/data/") |>
    req_headers("Content-Type" = "application/json") |>
    req_body_json(parameters, auto_unbox = TRUE) |>
    req_perform()
  
  if (resp_status(response) != 200) {
    stop(paste("API Error:", resp_status(response)))
  }
  
  return(resp_body_json(response))
}

all_data <- list()

for (table_id in table_ids) {
  parameters <- list(
    registrationkey = bls_key,
    seriesid = list(table_id),
    startyear = "2018",
    endyear = "2024",
    calculations = TRUE
  )
  
  bls_data_object <- get_bls_data(parameters)
  all_data[[table_id]] <- bls_data_object
}

file_path <- file.path(getwd(), "all_data_report.json")

write_json(all_data, path = file_path, pretty = TRUE)

dat <- fromJSON(file_path)

5# Clean data

series_dat <- dat |>
  map( ~ .x$Results$series) |>
  map( ~ tibble(seriesID = .x$seriesID, data = .x$data)) |> 
  list_rbind()

combined_dat <- series_dat |>
  unnest(data)

clean_dat <- combined_dat |>
  mutate(
    year_month = ymd(paste(year, str_sub(period, 2, 3), "01", sep = "-")),
    value = as.numeric(value),
    seriesID = as.character(seriesID),
    category_label = recode(seriesID, !!!id_to_label)
  )

january_2018_values <- clean_dat |>
  filter(year_month == ymd("2018-01-01")) |>
  select(seriesID, jan_2018_value = value) |>
  distinct()

joined_dat <- clean_dat |>
  left_join(january_2018_values, by = "seriesID")

final_cpi_dat <- joined_dat |>
  mutate(
    jan_2018_diff = value - jan_2018_value,
    jan_2018_pct_change = (jan_2018_diff / jan_2018_value) * 100
  ) |>
  arrange(year_month) |>
  mutate(percent_change_from_previous_month = (value / lag(value) - 1) * 100,
         .by = category_label)

6# Pin data to Connect

board <- board_connect()
pin_write(board = board, name = "isabella.velasquez/bls-cpi-data", x = final_cpi_dat)

Terminal

rsconnect::deployApp(appFiles = "script.R")

index.qmd

---
title: "Inflation explorer: showing the change in price for various goods and services"
format:
1  dashboard:
2    logo: images/logo.png
    nav-buttons:
    - icon: github
      href: "https://github.com/ivelasq/inflation-explorer"
    theme:
    - pulse
    - custom.scss
3resource_files:
- custom.scss
- images/logo.png
---

4```{r}
#| label: setup
#| include: false
library(pins)
library(lubridate)
library(dplyr)
library(tidyr)
library(ggplot2)
library(RColorBrewer)
library(gt)
library(plotly)

5board <-
  board_connect(
    auth = "manual",
    server = "https://pub.demo.posit.team/",
    key = Sys.getenv("CONNECT_API_KEY")
  )

df <-
  pin_read(board = board, name = "isabella.velasquez/bls-cpi-data") |>
  mutate(year_month = as.Date(year_month, format = "%Y-%m-%d"))

# Value for last updated date
last_updated_date <- df |>
  summarise(last_updated_date = max(year_month)) |>
  pull(last_updated_date)

# Value for the percentage change from the previous month
cpi_df <- df |> 
  filter(seriesID == "CUUR0000SA0")

latest_cpi_value <- cpi_df |>
  summarise(latest_value = last(value)) |>
  pull(latest_value)

latest_cpi_percent_change <- cpi_df |>
  filter(year_month == last_updated_date) |>
  pull(jan_2018_pct_change)

# Data for table
pivot_df <- df |> 
  select(category_label, year_month, percent_change_from_previous_month) |>
  pivot_wider(names_from = year_month, 
              values_from = percent_change_from_previous_month) %>%
  select(category_label, tail(names(.), 5)) |> 
  arrange(desc(category_label))
```

## Row {height=20%}

```{r} 
#| label: valuebox1
#| content: valuebox
#| title: "Last updated"
#| color: #fff
6last_updated_date
```

```{r} 
#| label: valuebox2
#| content: valuebox
#| title: "Consumer Price Index (CPI)"
#| icon: basket
7list(
  value = round(latest_cpi_value, 2),
  icon = "basket",
  color = "primary"
)
```

```{r}
#| label: valuebox3
#| content: valuebox
#| title: "Increase from previous month"
#| icon: percent
#| color: primary
value = round(latest_cpi_percent_change, 2)
```

## Row {height=80%}

### Column {width=20%}

The **Consumer Price Index (CPI)** is a measure of the average change over time in the prices paid by urban consumers for a market basket of consumer goods and services. 

Indexes are available for the U.S. and various geographic areas. Average price data for select utility, automotive fuel, and food items are also available.

**Source: Bureau of Labor Statistics**

### Column {.tabset width=80%}

```{r}
#| label: pct-change-jan-2018-code
#| include: false
8df <- df %>%
  arrange(desc(category_label), desc(year_month))

p1 <- ggplot(df,             
             aes(x = year_month, 
                 y = jan_2018_pct_change, 
                 color = category_label,
                 group = category_label)) +
  geom_line(aes(group = category_label)) +
  scale_color_manual(values = ifelse(df$category_label == "All groups CPI",
                                     "#765AAF", "#765AAF")) +
  theme_minimal() +
  theme(
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.text.x = element_text(size = 8),
    axis.text.y = element_text(size = 9)
    )
```

::: {.card title="Percentage change since Jan 2018"}

Use this inflation data explorer to see which goods and services are getting cheaper or more expensive in the U.S.

```{r}
#| fig-width: 20
#| fig-height: 8
ggplotly(p1)
```
:::

```{r}
#| label: pct-change-monthly-code
#| include: false
latest_month_data <- df %>%
  filter(year_month == max(year_month)) %>%
  arrange(desc(percent_change_from_previous_month))

top_six_categories <- latest_month_data %>%
  slice_head(n = 6)

p2 <- ggplot(
  top_six_categories,
  aes(
    x = reorder(category_label, -percent_change_from_previous_month),
    y = percent_change_from_previous_month,
    fill = category_label
  )
) +
  geom_bar(stat = "identity") +
  scale_fill_manual(values = rev(colorRampPalette(brewer.pal(9, "BuPu"))(6))) +
  labs(x = "", y = "Percent Change") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
  theme_minimal() +
  theme(
    legend.position = "none",
    axis.text.x = element_text(size = 24),
    axis.title.x = element_text(size = 20),
    axis.text.y = element_text(size = 24)
  ) +
  coord_flip()
```

::: {.card title="Last month's top 6"}
Percentage change in CPI by category for the last month, top six categories

```{r}
#| fig-width: 18
#| fig-height: 8
p2
```
:::

```{r}
#| label: pct-change-monthly-table
#| title: "Monthly changes in prices"
colnames(pivot_df)[1] <- "Category" 
colnames(pivot_df)[-1] <- format(ymd(colnames(pivot_df)[-1]), "%B %Y")

pivot_gt <- pivot_df %>% 
9  gt() %>%
  tab_header(
    title = "Monthly Percent Change by Category",
    subtitle = "Last four months"
  ) %>%
  fmt_number(
    columns = 2:5,
    decimals = 2,
  ) %>%
  tab_style(
    style = cell_text(weight = "bold", align = "center"),
    locations = cells_column_labels(everything())
  ) |> 
  data_color(
    method = "numeric",
    palette = "BuPu"
  )

pivot_gt
```