Quarto dashboard creation and automation

[This article was first published on %>% dreams, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

A young woman pinning something red on her green dress.

John White Alexander, Study in Black and Green

I had the opportunity to present an automated Quarto dashboard on Posit’s Monthly End-to-End Workflow with Posit Team, followed by a Q&A. The project involved a script that retrieves Consumer Price Index (CPI) data from the Bureau of Labor Statistics (BLS) API, processes and cleans the data, and saves it as a pin using the {pins} package to Posit Connect1. A .qmd file then reads the pinned data and generates a Quarto dashboard, which is deployed to Posit Connect. Both the script and the .qmd file are scheduled to run monthly on Posit Connect, ensuring the pin and dashboard always reflect the latest data from the BLS. You can watch the recording here:

The workflow was implemented in Python, and one of the most common questions I received was, “Can I do this in R?” The answer is: absolutely! A key advantage of the tools used in this workflow is their multilingualism or the availability of equivalent tools in both R and Python.

  • The {pins} package is available in both R and Python.
  • Quarto is independent of the computational environment and can be run with either a knitr engine (for R) or a Jupyter engine (for Python).
  • Posit Connect supports hosting data products created in both R and Python.

This blog post will guide you through the equivalent workflow in R, which can be found in this repository. If you’re interested in the Python version, you can explore it in this repository.

This post features Posit Connect heavily, but there are other tools available. For example,I’ve written a blog post on creating an automated dashboard using {flexdashboard} and GitHub Actions, which you can check out here.

Before we begin… Quarto dashboards?!

That’s right! With version 1.4, Quarto now supports dashboards — a new output format for easily creating dashboards from notebooks in R, Python, or Julia. You can include plots, tables, value boxes, and text, and deploy your dashboards as static web pages (no special server needed). For enhanced interactivity, you can integrate a backend Shiny server. You can also customize the appearance by adding a Bootstrap theme or custom Sass elements.

To learn more about creating dashboards, check out the Quarto documentation or watch my R-Ladies Rome Quarto Dashboards talk.

Consumer Price Index (CPI) data

This dashboard uses the Consumer Price Index (CPI) data from the Bureau of Labor Statistics (BLS). The CPI monitors changes in the prices of a basket of goods over time, covering a range of categories, and is updated monthly. The dashboard automatically refreshes each month when the latest BLS data is released.

Setup

To open the project in RStudio, navigate to File > New Project > Version Control and paste the following URL: https://github.com/posit-marketing/inflation-explorer.git.

The files in the project include:

├── images
│   └── logo.png            # Logo image to use in the dashboard
├── .gitignore              # Files and folders to ignore when pushing up changes
├── README.md               # Project overview and setup instructions
├── _publish.yml            # File for specifying the publishing destination
├── _quarto.yml             # Quarto project configuration file
├── all_data_report.json    # JSON version of the downloaded BLS data
├── custom.scss             # Custom Sass file
├── index.qmd               # Quarto dashboard document
└── script.R                # Python script version of the ETL script

Virtual environments

In the Python version of this demo, I created a virtual environment. Virtual environments are commonly used to manage dependencies and isolate project-specific packages. In R, using virtual environments are less common. R installs packages either system-wide or in user-specific library paths. If you are an RStudio Projects user, the project-specific settings manage your dependencies. And in general, R’s package management system is more flexible with handling packages. However, the {renv} package provides similar functionality to Python’s virtual environments by managing project-specific dependencies and package versions.

Environment variables

Environment variables are variables that are needed for code but should not be publicly shared. This project has three:

  1. BLS_KEY: A BLS API access token, obtained at https://www.bls.gov/developers/home.htm.
  2. CONNECT_SERVER: The URL for the Connect server.
  3. CONNECT_API_KEY: The access key for the Connect server.

To store these variables in your R environment (.Renviron), you can use Sys.setenv() in your Terminal:

Terminal
Sys.setenv("connect api key here")

Or, you can edit your .Renviron file using the {usethis} package. Run usethis::edit_r_environ() to open the .Renviron file and add the variables manually.

Extract-transform-load process

We use a script to pull raw data from the BLS API, clean it for use in our dashboard, and then save it as a pin. This process, known as Extract-Transform-Load (ETL), is executed in the script.R file:

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)
1
The {pins} package allows you to pin data, models, or other objects for easy access or sharing. Pins are ideal for ephemeral, ever-changing data that needs to be referenced but does not require a database.
2
We load the environment variables configured earlier.
3
Next, we define the list of BLS tables containing the data we want to display on the dashboard.
4
A function then pulls this data into R.
5
This is followed by a series of data cleaning and transformation steps.
6
Finally, we configure our Posit Connect server2 and write the pin to Connect. Access the pin here.

Posit Connect supports rendering script files (e.g., .py or .R). Once deployed to Connect, these scripts can be scheduled for automatic refresh and their output can be emailed, similar to other content on Connect. For more details, refer to the Scripts documentation.

To publish script.R to Connect, run the following command:

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

This is the content owner view of the deployed script. You can configure it to update daily at 11 PM PT using the configuration pane.

View the deployed script here.

Creating a Quarto dashboard

Now, we can move on to actually creating a Quarto dashboard!

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
```
1
Set the format to dashboard to create a Quarto dashboard.
2
Incorporate additional files, like a custom Sass file for themes and a logo.
3
Include resources for Posit Connect integration.
4
Use Quarto chunk options, as shown in this setup chunk.
5
Connect to Posit Connect and retrieve the recently created pin.
6
Add value boxes to highlight key text or numbers.
7
Use thelist() format as needed.
8
Embed static or interactive plots to enrich your dashboard with text and visuals.
9
Include tables as well.

Publishing scripts and dashboards

There are several ways to publish Quarto dashboards, as detailed in the publishing section of the Quarto website. In the webinar, I focused on Posit Connect. If you’re using RStudio, there are multiple deployment options for Connect, including push-button publishing, Git-backed publishing, and command-line publishing. Posit Connect also allows you to schedule document and script refreshes through a user-friendly configuration window.

Footnotes

  1. Posit’s enterprise publishing platform.↩︎

  2. To publish scripts, your Connect account must be linked. For details, refer to the Publishing documentation. Additionally, you need to provide the environment variables to Connect for use in the script. This can be done via the configuration pane or within the rsconnect::deployApp() command.↩︎

To leave a comment for the author, please follow the link and comment on their blog: %>% dreams.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)