---
title: "Signals and Cycles: The Economic Pulse"
subtitle:  "U.S. Economic Performance Report"
author: "Jim Amorin, CAE, MAI, SRA, AI-GRS, CDEI"
date: today
format:
  html:
    toc: true
    toc-depth: 3
    code-fold: true
    theme: cosmo
    embed-resources: true

execute:
  echo: false
  warning: false
  message: false
---
![](logo.png){width=260px style="display:block; margin-left:0; margin-bottom:20px;"}


```{r setup}
#| include: false

# Setup and Configuration

# Load required packages
required_packages <- c(
  "tidyverse",    # Data manipulation
  "fredr",        # FRED API access
  "lubridate",    # Date handling
  "scales",       # Formatting
  "knitr",        # Tables
  "kableExtra",   # Enhanced tables
  "plotly",       # Interactive charts
  "httr",         # API calls
  "jsonlite",     # JSON parsing
  "zoo",          # Time series
  "ggrepel"       # Label positioning
)

# Install missing packages
new_packages <- required_packages[!(required_packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages, repos = "https://cran.rstudio.com/")

# Load all packages
invisible(lapply(required_packages, library, character.only = TRUE))

# API Configuration
# IMPORTANT: Set your API keys here or in .Renviron file
FRED_API_KEY <- Sys.getenv("FRED_API_KEY")
BEA_API_KEY <- Sys.getenv("BEA_API_KEY")
OPENAI_API_KEY <- Sys.getenv("OPENAI_API_KEY")

if(FRED_API_KEY == "") {
  stop("FRED API key not found. Set FRED_API_KEY in .Renviron or environment variables.
       Get free key at: https://fred.stlouisfed.org/docs/api/api_key.html")
}

# Set FRED API key
fredr_set_key(FRED_API_KEY)

# Cache directory for data
cache_dir <- "data_cache"
if(!dir.exists(cache_dir)) dir.create(cache_dir)

# Global theme settings
theme_set(theme_minimal(base_size = 12))
```


```{r helper_functions}
#| message: true
#| warning: false
#| include: true

# Helper Functions


# Function to fetch FRED data with caching
fetch_fred_data <- function(series_id, cache_hours = 24) {
  cache_file <- file.path(cache_dir, paste0(series_id, ".rds"))
  
  # Check if cache exists and is recent
  if(file.exists(cache_file)) {
    cache_time <- file.info(cache_file)$mtime
    if(difftime(Sys.time(), cache_time, units = "hours") < cache_hours) {
      return(readRDS(cache_file))
    }
  }
  
  # Fetch fresh data
  tryCatch({
    data <- fredr(series_id = series_id)
    saveRDS(data, cache_file)
    return(data)
  }, error = function(e) {
    warning(paste("Error fetching", series_id, ":", e$message))
    return(NULL)
  })
}

# Function to get latest, 1M ago, 6M ago, 1Y ago values
get_historical_values <- function(data, metric_name) {
  if(is.null(data) || nrow(data) == 0) {
    return(tibble(
      Metric = metric_name,
      Latest = NA,
      `1M Ago` = NA,
      `6M Ago` = NA,
      `1Y Ago` = NA,
      `Change` = ""
    ))
  }
  
  data <- data %>%
    arrange(desc(date)) %>%
    filter(!is.na(value))
  
  if(nrow(data) == 0) {
    return(tibble(
      Metric = metric_name,
      Latest = NA,
      `1M Ago` = NA,
      `6M Ago` = NA,
      `1Y Ago` = NA,
      `Change` = ""
    ))
  }
  
  latest_date <- data$date[1]
  latest_value <- data$value[1]
  
  # Find closest dates to 1M, 6M, 1Y ago
  date_1m <- latest_date %m-% months(1)
  date_6m <- latest_date %m-% months(6)
  date_1y <- latest_date %m-% months(12)
  
  value_1m <- data %>% 
    filter(date <= date_1m) %>% 
    slice(1) %>% 
    pull(value)
  
  value_6m <- data %>% 
    filter(date <= date_6m) %>% 
    slice(1) %>% 
    pull(value)
  
  value_1y <- data %>% 
    filter(date <= date_1y) %>% 
    slice(1) %>% 
    pull(value)
  
  # Calculate directional arrow
  if(length(value_1y) > 0 && !is.na(value_1y)) {
    change_pct <- ((latest_value - value_1y) / abs(value_1y)) * 100
    if(change_pct > 5) {
      arrow <- "⬆️"
    } else if(change_pct < -5) {
      arrow <- "⬇️"
    } else {
      arrow <- "➡️"
    }
  } else {
    arrow <- ""
  }
  
  tibble(
    Metric = metric_name,
    Latest = ifelse(length(latest_value) > 0, latest_value, NA),
    `1M Ago` = ifelse(length(value_1m) > 0, value_1m, NA),
    `6M Ago` = ifelse(length(value_6m) > 0, value_6m, NA),
    `1Y Ago` = ifelse(length(value_1y) > 0, value_1y, NA),
    `Change` = arrow
  )
}

# Function to create time series chart
create_ts_chart <- function(data_list, title, ylab = "Value", legend_labels = NULL) {
  combined_data <- bind_rows(lapply(names(data_list), function(name) {
    if(!is.null(data_list[[name]])) {
      data_list[[name]] %>%
        mutate(series = name)
    }
  }))
  
  if(nrow(combined_data) == 0) return(NULL)
  
  if(!is.null(legend_labels)) {
    combined_data <- combined_data %>%
      mutate(series = factor(series, levels = names(legend_labels), labels = legend_labels))
  }
  
  p <- ggplot(combined_data, aes(x = date, y = value, color = series)) +
    geom_line(linewidth = 1) +
    labs(title = title, x = NULL, y = ylab, color = NULL) +
    theme_minimal(base_size = 12) +
    theme(
      legend.position = "bottom",
      plot.title = element_text(face = "bold", size = 14)
    ) +
    scale_x_date(date_breaks = "1 year", date_labels = "%Y")
  
  return(p)
}

# Format table output
format_monitor_table <- function(df) {
  df %>%
    mutate(across(where(is.numeric), ~round(., 2))) %>%
    kbl(align = c("l", rep("r", ncol(df)-1))) %>%
    kable_styling(
      bootstrap_options = c("striped", "hover", "condensed"),
      full_width = FALSE,
      position = "left"
    )
}

format_status_table <- function(df) {
  if (is.null(df) || nrow(df) == 0) return("")

  df <- df %>%
    mutate(across(where(is.numeric), ~round(., 2)))

  lines <- apply(df, 1, function(row) {
    metric <- row[["Metric"]]
    latest <- row[["Latest"]]
    m1 <- if ("1M Ago" %in% names(row)) row[["1M Ago"]] else NA
    m6 <- if ("6M Ago" %in% names(row)) row[["6M Ago"]] else NA
    y1 <- if ("1Y Ago" %in% names(row)) row[["1Y Ago"]] else NA
    d1m <- if ("Δ 1M" %in% names(row)) row[["Δ 1M"]] else NA
    d6m <- if ("Δ 6M" %in% names(row)) row[["Δ 6M"]] else NA
    d1y <- if ("Δ 1Y" %in% names(row)) row[["Δ 1Y"]] else NA
    paste0(
      metric, ": latest=", latest,
      "; 1m=", m1, "; 6m=", m6, "; 1y=", y1,
      "; d1m=", d1m, "; d6m=", d6m, "; d1y=", d1y
    )
  })

  paste(lines, collapse = "\n")
}

compute_cache_signature <- function(series_ids, cache_dir = "data_cache") {
  entries <- vapply(series_ids, function(series_id) {
    cache_file <- file.path(cache_dir, paste0(series_id, ".rds"))
    if (!file.exists(cache_file)) {
      return(paste0(series_id, ":missing"))
    }
    md5 <- as.character(tools::md5sum(cache_file))
    paste0(series_id, ":", md5)
  }, character(1))

  paste(entries, collapse = "|")
}

load_status_cache <- function(cache_file) {
  if (file.exists(cache_file)) {
    return(readRDS(cache_file))
  }
  list()
}

save_status_cache <- function(cache, cache_file) {
  saveRDS(cache, cache_file)
}

call_openai_summary <- function(prompt, model = NULL) {
  api_key <- OPENAI_API_KEY
  if (is.null(model) || model == "") {
    model <- Sys.getenv("OPENAI_MODEL", "gpt-4o-mini")
  }
  if (api_key == "") return(NULL)

  response <- tryCatch({
    httr::POST(
      url = "https://api.openai.com/v1/chat/completions",
      httr::add_headers(Authorization = paste("Bearer", api_key)),
      httr::content_type_json(),
      encode = "json",
      body = list(
        model = model,
        temperature = 0.3,
        max_tokens = 140,
        messages = list(
          list(
            role = "system",
            content = "You are a concise economic analyst. Write 2-3 sentences, no bullets, present tense."
          ),
          list(role = "user", content = prompt)
        )
      )
    )
  }, error = function(e) {
    NULL
  })

  if (is.null(response) || httr::http_error(response)) return(NULL)

  raw_text <- httr::content(response, "text", encoding = "UTF-8")
  parsed <- tryCatch({
    jsonlite::fromJSON(raw_text, simplifyVector = FALSE)
  }, error = function(e) {
    NULL
  })
  if (is.null(parsed) || !is.list(parsed)) return(NULL)
  if (!is.null(parsed$error)) return(NULL)
  if (is.null(parsed$choices) || length(parsed$choices) == 0) return(NULL)

  parsed$choices[[1]]$message$content
}

generate_current_status <- function(section_id, section_title, data_text, cache_signature, fallback_text) {
  cache_file <- file.path("data_cache", "current_status_cache.rds")
  cache <- load_status_cache(cache_file)

  if (!is.null(cache[[section_id]]) && cache[[section_id]]$signature == cache_signature) {
    return(cache[[section_id]]$text)
  }

  if (OPENAI_API_KEY == "" || data_text == "") {
    return(fallback_text)
  }

  prompt <- paste0(
    "Section: ", section_title, "\n",
    "Latest metrics and changes:\n", data_text, "\n",
    "Rewrite the Current Status summary."
  )

  summary <- call_openai_summary(prompt)
  if (is.null(summary) || summary == "") {
    return(fallback_text)
  }

  cache[[section_id]] <- list(signature = cache_signature, text = summary)
  save_status_cache(cache, cache_file)

  summary
}
```

```{r}
# Enhanced table formatter with red/green/blue arrows
format_monitor_table_with_arrows <- function(df) {
  if (is.null(df) || nrow(df) == 0) return(NULL)
  
  # Ensure columns exist before styling
  has_arrows <- all(c("Δ 1M", "Δ 6M", "Δ 1Y") %in% names(df))
  
  base_table <- df %>%
    mutate(across(where(is.numeric), ~round(., 2))) %>%
    kbl(align = c("l", rep("r", 4), rep("c", 3))) %>%
    kable_styling(
      bootstrap_options = c("striped", "hover", "condensed"),
      full_width = FALSE,
      position = "left"
    )
  
  if (!has_arrows) return(base_table)

  # Create safe color vectors (replace NAs with blue)
  col_1m <- case_when(
    df$`Δ 1M` == "▲" ~ "#28a745",
    df$`Δ 1M` == "▼" ~ "#dc3545",
    TRUE ~ "#007bff"
  )
  col_1m[is.na(col_1m)] <- "#007bff"
  
  col_6m <- case_when(
    df$`Δ 6M` == "▲" ~ "#28a745",
    df$`Δ 6M` == "▼" ~ "#dc3545",
    TRUE ~ "#007bff"
  )
  col_6m[is.na(col_6m)] <- "#007bff"
  
  col_1y <- case_when(
    df$`Δ 1Y` == "▲" ~ "#28a745",
    df$`Δ 1Y` == "▼" ~ "#dc3545",
    TRUE ~ "#007bff"
  )
  col_1y[is.na(col_1y)] <- "#007bff"
  
  base_table %>%
    column_spec(6, color = col_1m) %>%
    column_spec(7, color = col_6m) %>%
    column_spec(8, color = col_1y)
}
```

```{r}
# ======================================================
# Enhanced global version of get_historical_values
# ======================================================

get_historical_values_with_changes <- function(data, metric_name) {
  if (is.null(data) || nrow(data) == 0) {
    return(tibble(
      Metric = metric_name,
      Latest = NA,
      `1M Ago` = NA,
      `6M Ago` = NA,
      `1Y Ago` = NA,
      `Δ 1M` = "—",
      `Δ 6M` = "—",
      `Δ 1Y` = "—"
    ))
  }

  data <- data %>%
    arrange(desc(date)) %>%
    filter(!is.na(value))

  if (nrow(data) == 0) {
    return(tibble(
      Metric = metric_name,
      Latest = NA,
      `1M Ago` = NA,
      `6M Ago` = NA,
      `1Y Ago` = NA,
      `Δ 1M` = "—",
      `Δ 6M` = "—",
      `Δ 1Y` = "—"
    ))
  }

  latest_date <- data$date[1]
  latest_value <- data$value[1]

  date_1m <- latest_date %m-% months(1)
  date_6m <- latest_date %m-% months(6)
  date_1y <- latest_date %m-% months(12)

  value_1m <- data %>% filter(date <= date_1m) %>% slice(1) %>% pull(value)
  value_6m <- data %>% filter(date <= date_6m) %>% slice(1) %>% pull(value)
  value_1y <- data %>% filter(date <= date_1y) %>% slice(1) %>% pull(value)

  threshold <- 0.01
  create_arrow <- function(current, past) {
    if (length(past) == 0 || is.na(past) || is.na(current)) return("—")
    diff <- current - past
    if (abs(diff) < threshold) return("—")
    if (diff > 0) return("▲")
    return("▼")
  }

  tibble(
    Metric = metric_name,
    Latest = latest_value,
    `1M Ago` = value_1m,
    `6M Ago` = value_6m,
    `1Y Ago` = value_1y,
    `Δ 1M` = create_arrow(latest_value, value_1m),
    `Δ 6M` = create_arrow(latest_value, value_6m),
    `Δ 1Y` = create_arrow(latest_value, value_1y)
  )
}

# Make this the default everywhere, globally
get_historical_values <- get_historical_values_with_changes
```

```{r}
# ==========================================
# Global Visualization Controls
# ==========================================
chart_start_date <- as.Date("2000-01-01")   # Set global time frame
x_axis_interval  <- 2                       # Show year labels every 2 years
chart_colors <- c(                          # Global color palette
  "Series1" = "#BF5700",  # Burnt Orange (primary)
  "Series2" = "#333F48",  # Charcoal Gray
  "Series3" = "#61A5C2",  # Light Aquq Mist
  "Series4" = "#A7A8AA",  # Cool Silver Gray
  "Series5" = "#F2A900"   # Texas Gold Accent
)

# ==========================================
# NBER Recession Shading
# ==========================================

add_recession_shading <- function(p) {
  rec <- fredr(series_id = "USREC") %>%
    filter(date >= chart_start_date) %>%
    mutate(start_flag = value == 1 & lag(value, default = 0) == 0,
           end_flag   = value == 0 & lag(value, default = 0) == 1)
  
  # Identify start and end dates for recessions
  starts <- rec$date[rec$start_flag]
  ends   <- rec$date[rec$end_flag]
  
  # Handle case where recession is ongoing
  if (length(starts) > length(ends)) {
    ends <- c(ends, max(rec$date))
  }
  
  recession_periods <- tibble(start = starts, end = ends)
  
  if (nrow(recession_periods) > 0) {
    p + geom_rect(
      data = recession_periods,
      aes(xmin = start, xmax = end, ymin = -Inf, ymax = Inf),
      inherit.aes = FALSE,
      fill = "gray70", alpha = 0.2
    )
  } else {
    p
  }
}


# ==========================================
# Revised Time Series Chart Function
# ==========================================
create_ts_chart <- function(data_list, title, ylab = "Value", legend_labels = NULL) {
  # Combine multiple series into one data frame
  combined_data <- bind_rows(lapply(names(data_list), function(name) {
    if (!is.null(data_list[[name]])) {
      data_list[[name]] %>%
        filter(date >= chart_start_date) %>%
        mutate(series = name)
    }
  }))
  
  # Exit quietly if no valid data
  if (nrow(combined_data) == 0) return(NULL)
  
  # Apply custom legend labels if provided
  if (!is.null(legend_labels)) {
    combined_data <- combined_data %>%
      mutate(series = factor(series, levels = names(legend_labels), labels = legend_labels))
  }

  # Create unnamed color vector to avoid named-key mismatch
  color_values <- unname(rep(chart_colors, length.out = length(unique(combined_data$series))))
  
  # Build plot
  p <- ggplot(combined_data, aes(x = date, y = value, color = series)) +
    geom_line(linewidth = 1) +
    labs(title = title, x = NULL, y = ylab, color = NULL) +
    theme_minimal(base_size = 12) +
    theme(
      legend.position = "bottom",
      plot.title = element_text(face = "bold", size = 14)
    ) +
    scale_color_manual(values = color_values, na.translate = FALSE) +
    scale_x_date(
      date_breaks = paste0(x_axis_interval, " years"),
      date_labels = "%Y"
    )
  
  # Add NBER recession shading if applicable
  add_recession_shading(p)
}


```

------------------------------------------------------------------------

# Section 1: The Cost of Capital: Inflation, Yields, and Policy Signals

```{r section1_data}
#| message: false
#| warning: false
#| cache: true

# Fetch all Section 1 data series
series_s1 <- list(
  dgs10 = fetch_fred_data("DGS10"),      # 10Y Treasury
  dgs2 = fetch_fred_data("DGS2"),        # 2Y Treasury
  dgs30 = fetch_fred_data("DGS30"),      # 30Y Treasury
  dfii10 = fetch_fred_data("DFII10"),    # 10Y TIPS
  t10yie = fetch_fred_data("T10YIE"),    # 10Y Breakeven Inflation
  t10y2y = fetch_fred_data("T10Y2Y")     # 10Y-2Y Spread
)

# Calculate 30Y-10Y spread manually
if(!is.null(series_s1$dgs30) && !is.null(series_s1$dgs10)) {
  series_s1$spread_30y10y <- series_s1$dgs30 %>%
    left_join(series_s1$dgs10 %>% select(date, value_10y = value), by = "date") %>%
    mutate(
      value = value - value_10y,
      series_id = "CALCULATED_30Y10Y"  # Create a custom series ID
    ) %>%
    select(date, series_id, value)
} else {
  series_s1$spread_30y10y <- NULL
}

# Build summary table with new format
section1_table <- bind_rows(
  get_historical_values_with_changes(series_s1$dgs10, "10Y Treasury Rate (%)"),
  get_historical_values_with_changes(series_s1$dgs2, "2Y Treasury Rate (%)"),
  get_historical_values_with_changes(series_s1$dgs30, "30Y Treasury Rate (%)"),
  get_historical_values_with_changes(series_s1$dfii10, "10Y TIPS Yield (%)"),
  get_historical_values_with_changes(series_s1$t10yie, "10Y Breakeven Inflation (%)"),
  get_historical_values_with_changes(series_s1$t10y2y, "10Y-2Y Spread (%)"),
  get_historical_values_with_changes(series_s1$spread_30y10y, "30Y-10Y Spread (%)")
)

section1_status_fallback <- "Bond yields have declined modestly across most maturities, signaling an easing in overall borrowing costs but also reflecting investor caution about future growth. The flatter Treasury curve, with short-term rates falling more sharply than long-term yields, suggests expectations of slower economic momentum and potential Federal Reserve policy easing. Real yields remain contained and breakeven inflation stable, indicating that markets anticipate a soft landing rather than renewed inflationary pressure—conditions generally favorable for real estate financing and valuation stability."
section1_status <- generate_current_status(
  section_id = "section1",
  section_title = "Cost of Capital",
  data_text = format_status_table(section1_table),
  cache_signature = compute_cache_signature(c("DGS10", "DGS2", "DGS30", "DFII10", "T10YIE", "T10Y2Y")),
  fallback_text = section1_status_fallback
)
```

## Yield and Inflation Trends

Key treasury rates show the current interest rate environment and inflation expectations. The 10-year treasury yield serves as the benchmark risk-free rate, while Treasury Inflation-Protected Securities (TIPS) yields reflect real returns. The key difference between TIPS and ordinary Treasury bonds is that the principal value of TIPS automatically increases with inflation (as measured by the Consumer Price Index).Breakeven inflation rates indicate market expectations for future inflation over the next decade.

**Current Status**

`r section1_status`

### Current Rates Summary

```{r section1_table}
# Enhanced table formatting with colored arrows
section1_table %>%
  mutate(across(where(is.numeric), ~round(., 2))) %>%
  kbl(align = c("l", rep("r", 4), rep("c", 3))) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE,
    position = "left"
  ) %>%
  column_spec(6, color = case_when(
    section1_table$`Δ 1M` == "▲" ~ "#28a745",  # Green for up
    section1_table$`Δ 1M` == "▼" ~ "#dc3545",  # Red for down
    TRUE ~ "#007bff"  # Blue for no change
  )) %>%
  column_spec(7, color = case_when(
    section1_table$`Δ 6M` == "▲" ~ "#28a745",
    section1_table$`Δ 6M` == "▼" ~ "#dc3545",
    TRUE ~ "#007bff"
  )) %>%
  column_spec(8, color = case_when(
    section1_table$`Δ 1Y` == "▲" ~ "#28a745",
    section1_table$`Δ 1Y` == "▼" ~ "#dc3545",
    TRUE ~ "#007bff"
  ))
```

::: {.callout-note collapse="true"}
## Metrics Described

- 10-Year Treasury Rate (%): The 10-year Treasury yield reflects long-term borrowing costs and serves as a benchmark for mortgage and commercial loan rates. Lower yields tend to be favorable for real estate, as they reduce financing costs and increase investor appetite for property. However, if rates fall due to economic weakness, it can signal slowing growth rather than strength.

- 2-Year Treasury Rate (%): This yield captures short-term market expectations for Federal Reserve policy and near-term inflation. A lower 2-year rate generally eases credit conditions, supporting lending and investment. A rising rate, on the other hand, often reflects tightening monetary policy and pressure on short-term liquidity, which can dampen real estate activity.

- 30-Year Treasury Rate (%): The 30-year Treasury yield anchors long-term capital markets and affects fixed-rate mortgage pricing. Moderately lower long-term yields reduce debt service burdens and support valuations. Still, an excessively low rate can imply economic stagnation, while higher rates directly erode affordability and cash flow spreads.

- 10-Year TIPS Yield (%): TIPS (Treasury Inflation-Protected Securities) yields represent real, inflation-adjusted returns. Lower real yields tend to support real estate because they make tangible assets relatively more attractive to investors seeking inflation protection. Higher TIPS yields suggest tighter real returns and may draw capital away from property toward bonds.

- 10-Year Breakeven Inflation (%): This metric shows the market’s inflation expectations over the next decade (the difference between nominal Treasuries and TIPS yields). Moderate inflation expectations (around 2–2.5%) are healthiest for real estate, sustaining rent growth and asset appreciation without undermining affordability. Sharp increases signal inflation risk, while sharp drops may indicate deflationary pressures.

- 10-Year minus 2-Year Spread (%): The 10Y–2Y spread illustrates the slope of the yield curve between short- and long-term rates. A positive spread (higher 10-year than 2-year yield) indicates normal economic expansion and is beneficial for real estate lending and development. A negative or inverted spread suggests recession risk, typically coinciding with tighter lending and weaker transaction volumes.

- 30-Year minus 10-Year Spread (%): This spread compares very long-term and long-term yields, signaling investor confidence in distant future growth. A modestly positive spread supports stability in long-duration investments like commercial property, as it implies long-term optimism. A flat or negative spread can reflect uncertainty about future growth or structural stagnation concerns.
:::

### Historical Treasury Yield Curves

```{r section1_chart1, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "2Y" = series_s1$dgs2,
    "10Y" = series_s1$dgs10,
    "30Y" = series_s1$dgs30
  ),
  title = "Treasury Yield Curve Over Time",
  ylab = "Yield (%)"
)
```

### Inflation Expectations and Real Rates

```{r section1_chart2, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "10Y Breakeven Inflation" = series_s1$t10yie,
    "10Y TIPS (Real Yield)" = series_s1$dfii10
  ),
  title = "Inflation Expectations and Real Yields",
  ylab = "Rate (%)"
)
```

### Term Spread Analysis

```{r section1_chart3, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "10Y-2Y Spread" = series_s1$t10y2y
  ),
  title = "10Y-2Y Treasury Spread (Yield Curve)",
  ylab = "Spread (percentage points)"
) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red", alpha = 0.5)
```

***Note:** Negative values indicate yield curve inversion, historically a recession indicator.*

# Section 2: Risk Pricing and Credit Market Signals

```{r section2_data}
#| cache: true

# Fetch credit spread and volatility data
series_s2 <- list(
  aaa = fetch_fred_data("DAAA"),              # AAA Corporate Yield
  baa = fetch_fred_data("DBAA"),              # BAA Corporate Yield
  aaa10y = fetch_fred_data("AAA10Y"),         # AAA-10Y Spread
  baa10y = fetch_fred_data("BAA10Y"),         # BAA-10Y Spread
  vix = fetch_fred_data("VIXCLS"),            # VIX
  hy_oas = fetch_fred_data("BAMLH0A0HYM2"),   # High Yield OAS
  ig_oas = fetch_fred_data("BAMLC0A0CM"),     # Investment Grade OAS
  bbb_oas = fetch_fred_data("BAMLC0A4CBBB")   # BBB OAS
)

# Calculate IG vs HY spread differential
if(!is.null(series_s2$hy_oas) && !is.null(series_s2$ig_oas)) {
  series_s2$ig_hy_diff <- series_s2$hy_oas %>%
    left_join(series_s2$ig_oas %>% select(date, ig_value = value), by = "date") %>%
    mutate(value = value - ig_value) %>%
    select(date, value)  # Just keep date and value
} else {
  series_s2$ig_hy_diff <- NULL
}

section2_table <- bind_rows(
  get_historical_values(series_s2$aaa, "AAA Corporate Yield (%)"),
  get_historical_values(series_s2$baa, "BAA Corporate Yield (%)"),
  get_historical_values(series_s2$aaa10y, "AAA-10Y Spread (bps)"),
  get_historical_values(series_s2$baa10y, "BAA-10Y Spread (bps)"),
  get_historical_values(series_s2$vix, "VIX Index"),
  get_historical_values(series_s2$hy_oas, "High Yield OAS (bps)"),
  get_historical_values(series_s2$ig_oas, "Investment Grade OAS (bps)"),
  get_historical_values(series_s2$ig_hy_diff, "HY-IG Spread Differential (bps)")
)

section2_status_fallback <- "Credit markets show tentative easing after a period of elevated yields and spreads. Corporate borrowing costs have edged lower, while investment-grade and high-yield spreads have stabilized—signaling improved liquidity but lingering risk sensitivity. Volatility has risen slightly, yet the overall credit environment remains constructive, supporting refinancing activity and investor confidence across property sectors."
section2_status <- generate_current_status(
  section_id = "section2",
  section_title = "Risk Pricing and Credit Markets",
  data_text = format_status_table(section2_table),
  cache_signature = compute_cache_signature(c("DAAA", "DBAA", "AAA10Y", "BAA10Y", "VIXCLS", "BAMLH0A0HYM2", "BAMLC0A0CM", "BAMLC0A4CBBB")),
  fallback_text = section2_status_fallback
)
```

## The Cost of Risk: Credit Premiums and Volatility Indicators

Credit spreads measure the additional yield investors demand for corporate bonds over risk-free treasuries. Widening spreads indicate increased credit risk concerns, while the VIX reflects equity market volatility expectations. High yield spreads reached historic highs during the 2008 crisis and COVID-19 pandemic, providing crucial signals of market stress.

**Current Status**

`r section2_status`

### Credit Metrics Summary

```{r section2_table}
section2_table %>% format_monitor_table_with_arrows()
```

::: {.callout-note collapse="true"}
## Metrics Described
- AAA Corporate Yield (%): The AAA corporate yield represents borrowing costs for the highest-quality corporate issuers. Lower yields suggest strong credit markets, investor confidence, and low perceived risk, all of which support real estate by reducing financing costs and improving liquidity. Rising yields, conversely, signal tighter credit and increased caution among investors.

- BAA Corporate Yield (%): This reflects the borrowing rate for lower-investment-grade firms (still creditworthy but riskier than AAA). Lower yields imply healthy credit conditions and broad investor appetite for risk, benefiting real estate developers and tenants alike. Sustained increases often indicate deteriorating credit quality or higher financing costs across sectors.

- AAA–10-Year Treasury Spread (bps): This spread measures the premium that top-rated corporations pay over the risk-free Treasury rate. A narrower spread signals strong confidence in corporate credit and a stable economic outlook, favorable for property markets. A wider spread indicates rising credit risk aversion, which can slow lending and transactions.

- BAA–10-Year Treasury Spread (bps): This spread captures the additional yield required for moderate-risk companies compared to Treasuries. A smaller spread reflects confidence in business conditions and smoother credit flows, while a widening spread suggests growing credit stress. Real estate markets typically perform better when this spread remains contained, as it implies steady financing availability.

- VIX Index: The VIX measures expected stock market volatility, often called the “fear index.” Lower readings indicate market stability and risk appetite, both conducive to capital investment and real estate confidence. Higher levels signal investor uncertainty, frequently coinciding with reduced transaction volume and widening cap rates.

- High Yield OAS (bps): The High Yield Option-Adjusted Spread shows the extra yield investors demand for holding speculative-grade corporate debt. Lower spreads imply strong market liquidity and confidence in economic growth, both of which support real estate investment. Rising spreads point to tightening credit and growing recession risk.

- Investment Grade OAS (bps): This spread reflects the credit premium for investment-grade corporate bonds after adjusting for embedded options. Narrower spreads indicate stability and easy access to financing, while wider spreads suggest increased caution or emerging stress. Real estate markets thrive when spreads remain low and predictable.

- High Yield–Investment Grade Spread Differential (bps): This differential measures the risk gap between speculative and investment-grade debt. A narrow differential signals broad investor confidence and healthy credit conditions, whereas a widening gap often precedes economic slowdowns or market stress. Real estate values typically benefit when this spread remains tight, reflecting a stable credit environment.
:::

### Corporate Bond Spreads

```{r section2_chart1, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "AAA-10Y Spread" = series_s2$aaa10y,
    "BAA-10Y Spread" = series_s2$baa10y
  ),
  title = "Corporate Bond Credit Spreads Over 10Y Treasury",
  ylab = "Spread (basis points)"
)
```

### Option-Adjusted Spreads: Investment Grade vs High Yield

```{r section2_chart2, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Investment Grade OAS" = series_s2$ig_oas,
    "High Yield OAS" = series_s2$hy_oas
  ),
  title = "ICE BofA Option-Adjusted Spreads",
  ylab = "OAS (basis points)"
)
```

### Market Volatility Index (VIX)

```{r section2_chart3, fig.width=10, fig.height=6}
create_ts_chart(
  list("VIX" = series_s2$vix),
  title = "CBOE Volatility Index (VIX)",
  ylab = "Index Level"
) +
  geom_hline(yintercept = 20, linetype = "dashed", color = "orange", alpha = 0.5) +
  geom_hline(yintercept = 30, linetype = "dashed", color = "red", alpha = 0.5)
```

**Note:** VIX above 20 indicates elevated volatility; above 30 signals high fear in markets.

------------------------------------------------------------------------

# Section 3:Bank Lending Conditions and Credit Supply

```{r section3_data}
#| cache: true

# Fetch SLOOS (Senior Loan Officer Opinion Survey) data
series_s3 <- list(
  ci_large = fetch_fred_data("DRTSCILM"),      # C&I Loans - Large/Mid Firms
  ci_small = fetch_fred_data("DRTSCIS"),       # C&I Loans - Small Firms
  cre_construction = fetch_fred_data("SUBLPDRCSC"),  # CRE Construction
  cre_nonres = fetch_fred_data("SUBLPDRCSN"),       # CRE Nonfarm Nonresidential
  cre_multifamily = fetch_fred_data("SUBLPDRCSM"),  # CRE Multifamily
  credit_card = fetch_fred_data("DRTSCLCC"),        # Credit Card Loans
  auto = fetch_fred_data("STDSAUTO"),               # Auto Loans
  other_consumer = fetch_fred_data("STDSOTHCONS")   # Other Consumer Loans
)

section3_table <- bind_rows(
  get_historical_values(series_s3$ci_large, "C&I Loans - Large/Mid Firms (net %)"),
  get_historical_values(series_s3$ci_small, "C&I Loans - Small Firms (net %)"),
  get_historical_values(series_s3$cre_construction, "CRE - Construction (net %)"),
  get_historical_values(series_s3$cre_nonres, "CRE - Nonresidential (net %)"),
  get_historical_values(series_s3$cre_multifamily, "CRE - Multifamily (net %)"),
  get_historical_values(series_s3$credit_card, "Credit Card Loans (net %)"),
  get_historical_values(series_s3$auto, "Auto Loans (net %)"),
  get_historical_values(series_s3$other_consumer, "Other Consumer Loans (net %)")
)

section3_status_fallback <- "Bank lending standards continue to ease gradually from last year's tightening cycle. Commercial and industrial credit conditions have improved modestly, while construction and multifamily lending remain selective. This cautious normalization indicates that lenders are regaining confidence without abandoning risk discipline, a balance that favors steady but controlled real estate investment and development activity."
section3_status <- generate_current_status(
  section_id = "section3",
  section_title = "Bank Lending Conditions",
  data_text = format_status_table(section3_table),
  cache_signature = compute_cache_signature(c("DRTSCILM", "DRTSCIS", "SUBLPDRCSC", "SUBLPDRCSN", "SUBLPDRCSM", "DRTSCLCC", "STDSAUTO", "STDSOTHCONS")),
  fallback_text = section3_status_fallback
)
```

## Credit Flow Indicators and Lending Trends

The Senior Loan Officer Opinion Survey (SLOOS) tracks bank lending standards quarterly. Positive net percentages indicate more banks are tightening standards than easing, while negative values show net easing. Significant tightening typically precedes economic slowdowns, as reduced credit availability constrains business investment and consumer spending.

**Current Status**

`r section3_status`

### Bank Lending Standards Summary

```{r section3_table}
section3_table %>% format_monitor_table_with_arrows()
```

**Interpretation:** Net % = (% banks tightening - % banks easing). Positive values indicate restrictive lending conditions.

::: {.callout-note collapse="true"}
## Metrics Described
- C&I Loans – Large/Mid Firms (net %): This measures the net percentage of banks tightening or loosening credit standards for commercial and industrial loans to large and mid-sized firms. Lower values (closer to or below zero) indicate easier credit and a more supportive environment for business expansion, indirectly boosting demand for commercial space. Higher readings signal tightening standards and reduced credit availability, which can slow corporate investment and property absorption.

- C&I Loans – Small Firms (net %): Similar to the above but focused on small business borrowers, this measure captures how willing banks are to lend to smaller enterprises. Lower percentages imply more accommodating credit conditions and support for local retail, service, and light industrial tenants—vital segments of most property markets. Rising values suggest growing caution and tighter underwriting, which can suppress leasing and small-scale development.

- CRE – Construction (net %): This tracks banks’ lending standards for commercial real estate construction projects. Lower percentages indicate greater lending appetite, which typically accompanies expanding property supply and confidence in future demand. Higher readings mean banks are tightening terms, often in response to perceived risk or slower absorption, which can constrain new development pipelines.

- CRE – Nonresidential (net %): This reflects lending conditions for existing income-producing properties such as office, retail, and industrial assets. A lower percentage signals easier refinancing and acquisition financing, supporting transaction activity and stable valuations. Higher readings denote credit tightening, often associated with market stress or declining collateral performance.

- CRE – Multifamily (net %): This measures how banks are adjusting standards for apartment loans. A lower number suggests banks are comfortable lending to multifamily projects, usually due to strong rent fundamentals and demand stability. Higher percentages show tightening, often reflecting supply saturation or rising vacancy concerns, which can slow new construction and acquisition volume.

- Credit Card Loans (net %): This shows whether banks are tightening standards for consumer credit cards. Lower readings imply consumer strength and a healthy financial system, indirectly supporting retail sales and housing demand. Higher values indicate increased risk aversion and consumer stress, which can ripple through to reduced retail and service-sector occupancy.

- Auto Loans (net %): This metric tracks banks’ willingness to lend for vehicle purchases. Lower or negative values (indicating easier credit) suggest confidence in consumer credit quality and disposable income. Higher readings point to credit tightening and rising risk aversion, both of which can signal weakening consumer fundamentals that may affect retail real estate demand.

- Other Consumer Loans (net %): This encompasses bank lending standards for personal loans outside of auto or credit cards. A lower net percentage reflects easier access to credit and stronger household liquidity, both supportive of spending and housing activity. Higher values indicate tightening standards, which may reduce consumer confidence and spending capacity, indirectly cooling real estate markets.
:::

### Commercial & Industrial Lending Standards

```{r section3_chart1, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Large/Mid Firms" = series_s3$ci_large,
    "Small Firms" = series_s3$ci_small
  ),
  title = "C&I Loan Lending Standards (Net % Tightening)",
  ylab = "Net % Tightening"
) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray50", alpha = 0.5)
```

### Commercial Real Estate Lending Standards

```{r section3_chart2, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Construction" = series_s3$cre_construction,
    "Nonresidential" = series_s3$cre_nonres,
    "Multifamily" = series_s3$cre_multifamily
  ),
  title = "CRE Loan Lending Standards by Property Type",
  ylab = "Net % Tightening"
) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray50", alpha = 0.5)
```

### Consumer Lending Standards

```{r section3_chart3, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Credit Cards" = series_s3$credit_card,
    "Auto Loans" = series_s3$auto,
    "Other Consumer" = series_s3$other_consumer
  ),
  title = "Consumer Loan Lending Standards",
  ylab = "Net % Tightening"
) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray50", alpha = 0.5)
```

------------------------------------------------------------------------

# Section 4: Economic Growth & Employment Trends

```{r section4_data}
#| cache: true

# Fetch employment and growth data
series_s4 <- list(
  unrate = fetch_fred_data("UNRATE"),           # Unemployment Rate
  payems = fetch_fred_data("PAYEMS"),           # Nonfarm Payrolls
  civpart = fetch_fred_data("CIVPART"),         # Labor Force Participation
  wages = fetch_fred_data("CES0500000003"),     # Avg Hourly Earnings
  jolts = fetch_fred_data("JTSJOL"),            # Job Openings
  claims = fetch_fred_data("ICSA"),             # Initial Claims
  gdp_real = fetch_fred_data("A191RL1Q225SBEA"), # Real GDP Growth %
  indpro = fetch_fred_data("INDPRO")            # Industrial Production
)

# Calculate payroll changes (monthly)
series_s4$payems_change <- series_s4$payems %>%
  arrange(date) %>%
  mutate(value = value - lag(value, 1)) %>%
  filter(!is.na(value))

section4_table <- bind_rows(
  get_historical_values(series_s4$unrate, "Unemployment Rate (%)"),
  get_historical_values(series_s4$payems_change, "Monthly Payroll Change (thousands)"),
  get_historical_values(series_s4$civpart, "Labor Force Participation (%)"),
  get_historical_values(series_s4$wages, "Avg Hourly Earnings ($)"),
  get_historical_values(series_s4$jolts, "Job Openings (thousands)"),
  get_historical_values(series_s4$claims, "Initial Claims (thousands)"),
  get_historical_values(series_s4$gdp_real, "Real GDP Growth (% SAAR)"),
  get_historical_values(series_s4$indpro, "Industrial Production (Index)")
)

section4_status_fallback <- "Labor market conditions remain resilient despite signs of cooling. Job growth has slowed from earlier highs, but participation and wage gains continue to underpin consumer spending power. With unemployment still low by historical standards, the employment backdrop supports stable housing demand and tenant fundamentals even as the economy transitions toward slower but sustainable growth."
section4_status <- generate_current_status(
  section_id = "section4",
  section_title = "Economic Growth and Employment",
  data_text = format_status_table(section4_table),
  cache_signature = compute_cache_signature(c("UNRATE", "PAYEMS", "CIVPART", "CES0500000003", "JTSJOL", "ICSA", "A191RL1Q225SBEA", "INDPRO")),
  fallback_text = section4_status_fallback
)
```

## Employment Indicators and Economic Expansion

The labor market provides real-time signals about economic health. The unemployment rate remains the headline indicator, while job openings and initial claims offer higher-frequency leading indicators. Payroll growth combined with wage increases signals strong labor demand, though rapid wage growth can pressure inflation.

**Current Status**

`r section4_status`

### Labor Market Metrics

```{r section4_table}
section4_table %>% format_monitor_table_with_arrows()
```

::: {.callout-note collapse="true"}
## Metrics Described
- Unemployment Rate (%): The unemployment rate measures the share of the labor force actively seeking work but unable to find it. A lower rate reflects strong job creation and income stability—conditions that support housing demand, retail spending, and tenant expansion. Rising unemployment tends to weaken absorption and slow rent growth across property types.

- Monthly Payroll Change (thousands): This tracks the net number of jobs added or lost each month. Higher job gains indicate expanding employment bases and rising household formation, both vital for sustaining demand in residential and commercial real estate. Declines or persistently low job creation often foreshadow softening property fundamentals.

- Labor Force Participation (%): Labor force participation shows what portion of the working-age population is employed or seeking work. Higher participation rates suggest a broad and engaged workforce that underpins economic growth, household income, and real estate activity. Declines may reflect discouraged workers or demographic shifts that reduce long-term demand potential.

- Average Hourly Earnings ($): This measure tracks wage levels across the economy. Higher earnings generally signal rising purchasing power and rental affordability, supporting both residential and commercial property performance. However, if wage growth accelerates too quickly, it can contribute to inflation and prompt interest rate hikes that weigh on valuations.

- Job Openings (thousands): Job openings reflect employer demand for labor. A higher number indicates business expansion and confidence, which typically aligns with healthy leasing, construction, and investment trends. A sustained decline in openings often signals slowing economic activity that can pressure occupancy and pricing.

- Initial Claims (thousands): This metric reports the number of new unemployment insurance claims filed weekly. Lower levels suggest stable employment and minimal layoffs, reinforcing market confidence and steady rental demand. Higher claims imply job losses and economic stress, which tend to reduce spending and occupancy rates.

- Real GDP Growth (% SAAR): Real Gross Domestic Product growth captures the inflation-adjusted pace of economic output, shown as a seasonally adjusted annual rate. Higher growth reflects robust demand for goods, services, and space—conditions that favor rising rents and property values. Negative or slowing growth indicates contractionary trends that usually precede softer real estate performance.

- Industrial Production (Index): This index measures output from factories, mines, and utilities. Rising industrial production supports warehouse, manufacturing, and logistics property demand, while declines suggest weakening industrial activity. For investors, steady growth in this measure signals ongoing momentum in one of real estate’s key demand drivers..
:::

### Unemployment Rate and Labor Force Participation

```{r section4_chart1, fig.width=10, fig.height=6}
# Filter both series from 2000 onward
p1_data <- series_s4$unrate %>%
  filter(date >= chart_start_date) %>%
  mutate(metric = "Unemployment Rate")
p2_data <- series_s4$civpart %>%
  filter(date >= chart_start_date) %>%
  mutate(metric = "Labor Force Participation")

# Create unnamed color vector so ggplot assigns sequentially
color_values <- unname(rep(chart_colors, length.out = 2))

p <- ggplot() +
  geom_line(data = p1_data, aes(x = date, y = value, color = "Unemployment Rate"), linewidth = 1) +
  geom_line(data = p2_data, aes(x = date, y = value, color = "Labor Force Participation"), linewidth = 1) +
  labs(
    title = "Unemployment Rate and Labor Force Participation",
    x = NULL,
    y = "Percent (%)",
    color = NULL
  ) +
  theme_minimal(base_size = 12) +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold", size = 14)
  ) +
  scale_x_date(
    date_breaks = paste0(x_axis_interval, " years"),
    date_labels = "%Y"
  ) +
  scale_color_manual(values = color_values)

# Add recession shading
add_recession_shading(p)
```

### Monthly Payroll Changes

```{r section4_chart2, fig.width=10, fig.height=6}
# Filter to 2021–present
payroll_data <- series_s4$payems_change %>%
  filter(date >= as.Date("2021-01-01")) %>%
  mutate(
    change_type = if_else(value > 0, "Job Gains", "Job Losses"),
    change_type = factor(change_type, levels = c("Job Gains", "Job Losses"))
  )

# Build the chart
p <- ggplot(payroll_data, aes(x = date, y = value, fill = change_type)) +
  geom_col(color = "white", linewidth = 0.2, show.legend = TRUE) +
  scale_fill_manual(
    name = NULL,
    values = c(
      "Job Gains"  = as.character(chart_colors["Series1"]),  # Burnt Orange
      "Job Losses" = as.character(chart_colors["Series2"])   # Charcoal Gray
    )
  ) +
  labs(
    title = "Monthly Nonfarm Payroll Changes (2021–Present)",
    x = NULL,
    y = "Change (thousands)"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold", size = 14),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank()
  ) +
  geom_hline(yintercept = 0, color = "black") +
  scale_x_date(
    date_breaks = paste0(x_axis_interval, " years"),
    date_labels = "%Y",
    limits = c(as.Date("2021-01-01"), NA)
  ) +
  scale_y_continuous(labels = scales::comma)

add_recession_shading(p)

```

### Job Openings and Initial Claims

```{r section4_chart3, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Job Openings" = series_s4$jolts
  ),
  title = "Job Openings (JOLTS Survey)",
  ylab = "Thousands of Jobs"
) +
  scale_y_continuous(labels = comma)
```

### Real GDP Growth

```{r section4_chart4, fig.width=10, fig.height=6}
create_ts_chart(
  list("Real GDP Growth" = series_s4$gdp_real),
  title = "Real GDP Growth Rate (Quarterly, SAAR)",
  ylab = "Percent Change (%)"
) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red", alpha = 0.5)
```

------------------------------------------------------------------------

# Section 5: Consumer Demand and Trade Dynamics

```{r section5_data}
#| cache: true

# Fetch consumption and trade data
series_s5 <- list(
  retail = fetch_fred_data("RSAFS"),              # Retail Sales
  retail_ex_auto = fetch_fred_data("RSFSXMV"),    # Retail ex Auto
  ecommerce = fetch_fred_data("ECOMPCTSA"),       # E-commerce %
  pce = fetch_fred_data("PCE"),                   # Personal Consumption
  pce_real = fetch_fred_data("PCEC96"),           # Real PCE
  trade_balance = fetch_fred_data("BOPGSTB"),     # Trade Balance
  exports = fetch_fred_data("BOPTEXP"),           # Exports
  imports = fetch_fred_data("BOPTIMP"),           # Imports
  disposable_income = fetch_fred_data("DSPIC96")  # Real Disposable Income
)

section5_table <- bind_rows(
  get_historical_values(series_s5$retail, "Retail Sales ($ millions)"),
  get_historical_values(series_s5$retail_ex_auto, "Retail Sales ex Auto ($ millions)"),
  get_historical_values(series_s5$ecommerce, "E-commerce % of Retail"),
  get_historical_values(series_s5$pce, "Personal Consumption ($ billions)"),
  get_historical_values(series_s5$pce_real, "Real PCE ($ billions, 2017$)"),
  get_historical_values(series_s5$trade_balance, "Trade Balance ($ millions)"),
  get_historical_values(series_s5$exports, "Exports ($ millions)"),
  get_historical_values(series_s5$imports, "Imports ($ millions)"),
  get_historical_values(series_s5$disposable_income, "Real Disposable Income ($ billions)")
)

section5_status_fallback <- "Consumer activity remains a key driver of economic momentum, with retail sales and personal spending posting steady gains. Real disposable income and inflation-adjusted consumption continue to expand, reflecting household stability and confidence. Although import volumes and trade deficits fluctuate, overall consumption patterns suggest durable domestic demand—an encouraging signal for retail, logistics, and residential real estate sectors."
section5_status <- generate_current_status(
  section_id = "section5",
  section_title = "Consumer Demand and Trade",
  data_text = format_status_table(section5_table),
  cache_signature = compute_cache_signature(c("RSAFS", "RSFSXMV", "ECOMPCTSA", "PCE", "PCEC96", "BOPGSTB", "BOPTEXP", "BOPTIMP", "DSPIC96", "CPIAUCSL")),
  fallback_text = section5_status_fallback
)
```

## Domestic Demand and External Flows

Consumer spending drives approximately 70% of U.S. GDP, making retail sales and personal consumption critical indicators. E-commerce has accelerated dramatically, particularly post-COVID, reshaping retail dynamics. The trade balance reflects both domestic demand strength and global competitiveness.

**Current Trend**

`r section5_status`

### Consumption Metrics

```{r section5_table}
section5_table %>% format_monitor_table_with_arrows()
```

::: {.callout-note collapse="true"}
## Metrics Described
- Retail Sales ($ millions): Retail sales represent total spending at stores and online retailers. Higher sales indicate strong consumer demand, which supports retail leasing, warehouse distribution, and service-sector employment. A slowing or declining trend often signals weakening household confidence and can lead to store closures or reduced absorption in retail space.

- Retail Sales ex Auto ($ millions): This measure excludes automobile sales, which can be volatile, to reveal the underlying strength of everyday consumer spending. Higher values show broad-based retail activity and a resilient consumer base, both of which underpin tenant stability and shopping center performance. Lower readings point to softer discretionary spending and potential headwinds for retail property owners.

- E-commerce % of Retail: This ratio captures the share of total retail sales occurring online. A moderate increase reflects evolving consumer habits and steady digital integration into retail, supporting industrial and logistics real estate through fulfillment demand. However, sharp or sustained rises may pressure brick-and-mortar retail occupancy if not offset by experiential or service-based tenants.

- Personal Consumption ($ billions): Personal consumption measures total household spending on goods and services—the largest component of U.S. GDP. Higher consumption levels signify economic expansion and rising tenant and investor confidence across property sectors. Declines suggest constrained household budgets that can dampen retail and residential demand.

- Real Personal Consumption Expenditures (PCE) ($ billions, 2017$): Real PCE adjusts consumption for inflation, reflecting true growth in goods and services purchased. Higher real PCE is a sign of genuine demand strength and broad purchasing power, both of which are favorable for real estate markets. Weak or negative real growth suggests inflation is eroding real incomes and spending capacity.

- Trade Balance ($ millions): The trade balance measures the difference between exports and imports; negative values represent a deficit. A smaller deficit (less negative) or improving balance is generally healthier, reflecting stronger domestic production and export demand. Persistent or widening deficits can weigh on manufacturing and industrial property sectors that depend on export activity.

- Exports ($ millions): Exports measure the value of goods and services sold abroad. Higher exports indicate competitive domestic industries and sustained industrial demand, which supports warehouse, port, and logistics properties. Falling export volumes can reflect global demand weakness that reduces manufacturing output and property utilization.

- Imports ($ millions): Imports represent goods and services purchased from abroad. Moderate increases are consistent with healthy consumer and business demand, but excessive import growth relative to exports can widen trade deficits. For real estate, rising imports often boost demand for logistics and distribution space, especially near major ports and transportation hubs.

- Real Disposable Income ($ billions): This metric reflects household income after taxes, adjusted for inflation. Higher real disposable income supports spending on housing, retail goods, and services, providing the foundation for real estate demand. Declines or stagnation erode purchasing power and can lead to affordability challenges in both residential and commercial markets.
:::

### Retail Sales Trends

```{r section5_chart1, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Total Retail Sales" = series_s5$retail,
    "Retail ex Auto" = series_s5$retail_ex_auto
  ),
  title = "Retail Sales (Including Food Services)",
  ylab = "$ Millions"
) +
  scale_y_continuous(labels = comma)
```

### E-Commerce Penetration

```{r section5_chart2, fig.width=10, fig.height=6}
create_ts_chart(
  list("E-commerce % of Total Retail" = series_s5$ecommerce),
  title = "E-Commerce as Percentage of Total Retail Sales",
  ylab = "Percent (%)"
)
```

### Real Retail Sales vs Real Consumer Spending (Monthly % Change)

```{r section5_chart3, fig.width=10, fig.height=6}

# Fetch real retail sales, consumer spending, and CPI data
real_retail <- fetch_fred_data("RSAFS")        # Nominal retail sales
pce_real    <- fetch_fred_data("PCEC96")       # Real personal consumption expenditures
cpi         <- fetch_fred_data("CPIAUCSL")     # CPI for deflation adjustment

# Convert nominal retail sales to real (deflated by CPI)
real_retail_adj <- real_retail %>%
  left_join(cpi %>% select(date, cpi = value), by = "date") %>%
  mutate(value = value / (cpi / 100)) %>%
  select(date, value) %>%
  mutate(series = "Real Retail Sales")

# Keep Real PCE directly
pce_real_adj <- pce_real %>%
  mutate(series = "Real Consumer Spending") %>%
  select(date, value, series)

# Combine both and compute monthly percent change
combined <- bind_rows(real_retail_adj, pce_real_adj) %>%
  arrange(series, date) %>%
  group_by(series) %>%
  mutate(pct_change = (value / lag(value) - 1) * 100) %>%
  ungroup() %>%
  filter(date >= as.Date("2024-01-01"))  # Focus on recent period

# Prepare data for plotting
plot_df <- combined %>%
  select(date, series, pct_change)

# Define colors from global chart_colors
fill_colors <- unname(c(chart_colors["Series1"], chart_colors["Series2"]))
names(fill_colors) <- c("Real Retail Sales", "Real Consumer Spending")

# Plot grouped bar chart
ggplot(plot_df, aes(x = date, y = pct_change, fill = series)) +
  geom_col(position = position_dodge(width = 25), width = 25) +
  scale_fill_manual(values = fill_colors) +
  labs(
    title = "Consumer Spending and Retail Sales",
    x = "Month",
    y = "Monthly Change (%)",
    fill = NULL
   ) +
  scale_x_date(date_breaks = "1 month", date_labels = "%b %Y") +
  theme_minimal(base_size = 12) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(face = "bold", size = 14),
    legend.position = "bottom"
  )
```

### Personal Consumption Expenditures

```{r section5_chart4, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Nominal PCE" = series_s5$pce,
    "Real PCE" = series_s5$pce_real
  ),
  title = "Personal Consumption Expenditures",
  ylab = "$ Billions"
) +
  scale_y_continuous(labels = comma)
```

### Trade Balance

```{r section5_chart5, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Exports" = series_s5$exports,
    "Imports" = series_s5$imports
  ),
  title = "U.S. Exports and Imports",
  ylab = "$ Millions"
) +
  scale_y_continuous(labels = comma)
```

```{r section5_chart6, fig.width=10, fig.height=6}
create_ts_chart(
  list("Trade Balance" = series_s5$trade_balance),
  title = "U.S. Trade Balance (Goods and Services)",
  ylab = "$ Millions"
) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray50", alpha = 0.5) +
  scale_y_continuous(labels = comma)
```

------------------------------------------------------------------------

# Section 6: Construction Costs and Building Activity

```{r section6_data}
#| cache: true

# Fetch construction and PPI data
series_s6 <- list(
  ppi_construction = fetch_fred_data("WPUSI012011"),    # PPI Construction Materials
  ppi_lumber = fetch_fred_data("WPU081"),               # PPI Lumber
  ppi_steel = fetch_fred_data("WPU1017"),               # PPI Steel Mill Products
  ppi_concrete = fetch_fred_data("WPU1333"),            # PPI Ready-Mix Concrete
  housing_starts = fetch_fred_data("HOUST"),            # Housing Starts
  building_permits = fetch_fred_data("PERMIT"),         # Building Permits
  construction_spending = fetch_fred_data("TTLCONS"),   # Total Construction Spending
  res_construction = fetch_fred_data("TLRESCONS"),      # Residential Construction
  nonres_construction = fetch_fred_data("TLNRESCONS")   # Nonresidential Construction
)

section6_table <- bind_rows(
  get_historical_values(series_s6$ppi_construction, "PPI Construction Materials (Index)"),
  get_historical_values(series_s6$ppi_lumber, "PPI Lumber (Index)"),
  get_historical_values(series_s6$ppi_steel, "PPI Steel Mill Products (Index)"),
  get_historical_values(series_s6$ppi_concrete, "PPI Ready-Mix Concrete (Index)"),
  get_historical_values(series_s6$housing_starts, "Housing Starts (thousands, SAAR)"),
  get_historical_values(series_s6$building_permits, "Building Permits (thousands, SAAR)"),
  get_historical_values(series_s6$construction_spending, "Total Construction Spending ($ millions)"),
  get_historical_values(series_s6$res_construction, "Residential Construction ($ millions)"),
  get_historical_values(series_s6$nonres_construction, "Nonresidential Construction ($ millions)")
)

section6_status_fallback <- "Construction indicators reveal a market adjusting to cost pressures and tighter financing. Material prices remain elevated, yet housing starts and permit volumes have softened, suggesting a more disciplined supply pipeline. While total spending has eased, stable residential and infrastructure activity point to a sector in rebalancing rather than retreat—laying groundwork for healthier long-term fundamentals as supply aligns with demand."
section6_status <- generate_current_status(
  section_id = "section6",
  section_title = "Construction Costs and Building Activity",
  data_text = format_status_table(section6_table),
  cache_signature = compute_cache_signature(c("WPUSI012011", "WPU081", "WPU1017", "WPU1333", "HOUST", "PERMIT", "TTLCONS", "TLRESCONS", "TLNRESCONS")),
  fallback_text = section6_status_fallback
)
```

## Development Costs and Construction Trends

Construction cost inflation directly impacts real estate development feasibility and replacement costs. Lumber prices exhibit extreme volatility, while steel and concrete provide more stable baselines. Housing starts and building permits serve as leading indicators for residential construction activity, with permits typically leading starts by 1-2 months.

**Current Trend**

`r section6_status`

### Construction Metrics

```{r section6_table}
section6_table %>% format_monitor_table_with_arrows()
```

::: {.callout-note collapse="true"}
## Metrics Described
- PPI Construction Materials (Index): The Producer Price Index for construction materials tracks overall input costs for builders, including lumber, steel, and concrete. Lower readings are generally healthier, as they indicate stable or declining material prices that help control project costs and support profitability. Rapid increases, by contrast, can stall development pipelines and pressure margins.

- PPI Lumber (Index): This index measures wholesale prices for lumber, a key material in residential and light commercial construction. Moderate or declining values benefit builders by reducing framing and finishing costs. Sharp price spikes can delay projects and contribute to housing affordability challenges, especially in single-family markets.

- PPI Steel Mill Products (Index): The steel mill products index reflects the cost of steel used in structural framing, industrial buildings, and infrastructure. Lower prices support nonresidential and industrial construction by improving cost feasibility. Higher values, while sometimes signaling strong demand, often lead to project repricing or delays when budgets tighten.

- PPI Ready-Mix Concrete (Index): This index tracks prices for ready-mix concrete, a fundamental input for all major building types. Stable or modestly rising prices are manageable and consistent with healthy demand. However, sustained high increases can erode project returns and slow new development, particularly for multifamily and infrastructure projects.

- Housing Starts (thousands, SAAR): Housing starts represent the number of new residential units that have begun construction, shown at a seasonally adjusted annual rate. Higher levels indicate builder confidence, job creation in construction trades, and strong housing demand. Declines often point to tightening credit, rising costs, or weakening affordability—conditions that can constrain market supply.

- Building Permits (thousands, SAAR): Building permits measure approvals for new residential construction and serve as a leading indicator of future housing activity. Higher numbers signal optimism among builders and forthcoming supply, which helps balance markets. Falling permit activity suggests developer caution or financing challenges that may limit future inventory.

- Total Construction Spending ($ millions): This metric captures all public and private construction outlays nationwide. Rising spending reflects economic expansion, employment gains, and investment in both real estate and infrastructure. Persistent declines, however, can indicate slowing demand, cost inflation, or delayed projects across sectors.

- Residential Construction ($ millions): Residential spending tracks total outlays on single-family and multifamily housing. Higher spending supports job creation, material demand, and broader economic growth. Declines signal reduced builder activity or affordability pressures, which may lead to housing shortages and upward pressure on prices over time.

- Nonresidential Construction ($ millions): This measure includes commercial, industrial, institutional, and infrastructure construction. Higher values indicate corporate expansion, public investment, and business confidence—conditions that strengthen property fundamentals. Lower spending reflects caution among developers and public agencies, often tied to economic or credit constraints.
:::

### Construction Material Price Indices

```{r section6_chart1, fig.width=10, fig.height=6}
# Normalize to 100 at a specific date for comparison
base_date <- as.Date("2019-01-01")

normalize_series <- function(data, base_date) {
  if(is.null(data)) return(NULL)
  base_value <- data %>%
    filter(date >= base_date) %>%
    slice(1) %>%
    pull(value)
  
  data %>%
    mutate(value = (value / base_value) * 100)
}

normalized_list <- list(
  "Construction Materials" = normalize_series(series_s6$ppi_construction, base_date),
  "Lumber" = normalize_series(series_s6$ppi_lumber, base_date),
  "Steel" = normalize_series(series_s6$ppi_steel, base_date),
  "Concrete" = normalize_series(series_s6$ppi_concrete, base_date)
)

create_ts_chart(
  normalized_list,
  title = "Construction Material PPI (Indexed to Jan 2019 = 100)",
  ylab = "Index (2019 = 100)"
) +
  geom_hline(yintercept = 100, linetype = "dashed", color = "gray50", alpha = 0.5)
```

### Housing Starts and Building Permits

```{r section6_chart2, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Housing Starts" = series_s6$housing_starts,
    "Building Permits" = series_s6$building_permits
  ),
  title = "Housing Starts and Building Permits (Seasonally Adjusted)",
  ylab = "Thousands of Units (Annual Rate)"
) +
  scale_y_continuous(labels = comma)
```

### Construction Spending by Type

```{r section6_chart3, fig.width=10, fig.height=6}
create_ts_chart(
  list(
    "Residential" = series_s6$res_construction,
    "Nonresidential" = series_s6$nonres_construction
  ),
  title = "Construction Spending: Residential vs Nonresidential",
  ylab = "$ Millions (Seasonally Adjusted Annual Rate)"
) +
  scale_y_continuous(labels = comma)
```

------------------------------------------------------------------------

# Section 7: Metro Growth: People and Productivity

```{r section7_data}
#| message: false
#| warning: false
#| cache: false
#| results: hide

# Function to fetch MSA data from Census ACS (income + population)
fetch_msa_data <- function(top_n = 15, cache_hours = 24) {

  cache_file <- file.path("data_cache", "msa_growth_matrix.rds")
  if (file.exists(cache_file)) {
    cache_time <- file.info(cache_file)$mtime
    if (difftime(Sys.time(), cache_time, units = "hours") < cache_hours) {
      return(readRDS(cache_file))
    }
  }

  message("Fetching MSA data from Census ACS...")

  current_year <- as.integer(format(Sys.Date(), "%Y"))
  years <- seq(current_year - 1, current_year - 5, by = -1)
  acs_frames <- list()

  for (year in years) {
    acs_url <- paste0(
      "https://api.census.gov/data/", year,
      "/acs/acs1?get=NAME,B01003_001E,B19013_001E&for=metropolitan%20statistical%20area/micropolitan%20statistical%20area:*"
    )

    acs_raw <- tryCatch({
      jsonlite::fromJSON(acs_url)
    }, error = function(e) {
      NULL
    })

    if (!is.null(acs_raw) && nrow(acs_raw) > 1) {
      acs_frames[[as.character(year)]] <- as_tibble(acs_raw[-1, ]) %>%
        stats::setNames(acs_raw[1, ]) %>%
        mutate(
          cbsa_code = as.character(`metropolitan statistical area/micropolitan statistical area`),
          population = as.numeric(B01003_001E),
          income = as.numeric(B19013_001E),
          year = year
        ) %>%
        select(cbsa_code, msa = NAME, population, income, year)
    }
  }

  if (length(acs_frames) == 0) {
    message("✗ Census ACS returned no data")
    if (file.exists(cache_file)) {
      message("Using cached MSA data")
      return(readRDS(cache_file))
    }
    return(NULL)
  }

  acs_data <- bind_rows(acs_frames) %>%
    filter(!is.na(population), !is.na(income))

  result <- acs_data %>%
    group_by(cbsa_code, msa) %>%
    arrange(year) %>%
    summarise(
      latest_year = max(year),
      pop_latest = last(population),
      pop_first = first(population),
      income_latest = last(income),
      income_first = first(income),
      years_span = n(),
      pop_growth = if_else(
        years_span > 1,
        (((pop_latest / pop_first) ^ (1 / (years_span - 1))) - 1) * 100,
        NA_real_
      ),
      income_growth = if_else(
        years_span > 1,
        (((income_latest / income_first) ^ (1 / (years_span - 1))) - 1) * 100,
        NA_real_
      ),
      .groups = "drop"
    ) %>%
    filter(!is.na(pop_growth), !is.na(income_growth)) %>%
    arrange(desc(pop_latest)) %>%
    slice_head(n = top_n) %>%
    mutate(
      gdp_growth = income_growth,
      latest_gdp = income_latest
    ) %>%
    select(msa, gdp_growth, pop_growth, latest_gdp, latest_year)

  if (nrow(result) > 0) {
    saveRDS(result, cache_file)
    return(result)
  }

  if (file.exists(cache_file)) {
    message("Using cached MSA data")
    return(readRDS(cache_file))
  }

  return(NULL)
}

# Fetch data
msa_matrix_data <- fetch_msa_data(top_n = 15)

# Create plot
if (!is.null(msa_matrix_data) && nrow(msa_matrix_data) > 0) {
  
  msa_matrix_data <- msa_matrix_data %>%
    mutate(
      quadrant = case_when(
        gdp_growth >= 0 & pop_growth >= 0 ~ "Balanced Growth",
        gdp_growth >= 0 & pop_growth < 0  ~ "Productivity-Driven",
        gdp_growth < 0 & pop_growth >= 0  ~ "Demographic Pressure",
        TRUE                              ~ "Declining/Restructuring"
      )
    )
  
  section7_plot <- ggplot(msa_matrix_data, aes(x = pop_growth, y = gdp_growth, color = quadrant)) +
    geom_point(size = 4, alpha = 0.8) +
    geom_text_repel(
      aes(label = str_extract(msa, "^[^,]+")),
      size = 3, 
      max.overlaps = 25
    ) +
    geom_hline(yintercept = 0, linetype = "dashed", color = "gray60") +
    geom_vline(xintercept = 0, linetype = "dashed", color = "gray60") +
    scale_color_manual(values = unname(c(
      chart_colors["Series1"], chart_colors["Series2"],
      chart_colors["Series3"], chart_colors["Series4"]
    ))) +
    labs(
      title = "MSA Population vs Income Growth Matrix (ACS)",
      subtitle = "Annualized growth rates for top 15 metros by population",
      x = "Population Growth (% annual)",
      y = "Median Household Income Growth (% annual)",
      color = NULL
    ) +
    theme_minimal(base_size = 12) +
    theme(
      plot.title = element_text(face = "bold", size = 14),
      legend.position = "bottom"
    )
  
} else {
  section7_plot <- NULL
}
```

## The Growth Map: People, Productivity, and Place

**Metropolitan Statistical Areas (MSAs) show varying trajectories of economic and demographic growth.** This scatter plot reveals the top `r nrow(msa_matrix_data)` metropolitan areas which are experiencing balanced growth (both population and income increasing), productivity gains (income growing faster than population), or demographic pressure (population growing faster than income).[^acs]

```{r section7_chart}
#| fig.width: 12
#| fig.height: 8

if (!is.null(section7_plot)) {
  section7_plot
} else {
  cat("**Note:** MSA data unavailable. Census ACS data could not be retrieved.")
}
```

[^acs]: Source: U.S. Census Bureau, American Community Survey (ACS) 1-year estimates for metro/micro areas. Variables: population (B01003_001E) and median household income (B19013_001E).

### Interpretation Quadrants

- **Upper Right (High Pop, High Income):** Strong balanced growth metros
- **Upper Left (Low Pop, High Income):** Productivity-driven growth, potential housing constraints
- **Lower Right (High Pop, Low Income):** Demographic pressure, economic challenges
- **Lower Left (Low/Negative Both):** Declining metros, potential restructuring

```{r section7_table}
if(!is.null(msa_matrix_data) && nrow(msa_matrix_data) > 0) {
  msa_matrix_data %>%
    arrange(desc(gdp_growth)) %>%
    select(
      `Metropolitan Area` = msa,
      `Pop Growth (%)` = pop_growth,
      `Income Growth (%)` = gdp_growth
    ) %>%
    mutate(across(where(is.numeric), ~round(., 2))) %>%
    head(25) %>%
    format_monitor_table()
} else {
  cat("**Data unavailable**")
}
```

```{r}
#| label: fig-animated-income
#| fig-height: 8
#| fig-width: 12

if (!is.null(msa_matrix_data) && nrow(msa_matrix_data) > 0) {
  
  # Select top 15 MSAs to avoid overcrowding
  top_msas <- msa_matrix_data %>%
    arrange(desc(latest_gdp)) %>%
    head(15)
  
  # Create MANY frames for ultra-smooth motion
  years <- seq(2015, 2023, by = 0.1)
  
  set.seed(42)  # For reproducible animation
  
  animated_data <- expand.grid(
    msa = top_msas$msa,
    year = years,
    stringsAsFactors = FALSE
  ) %>%
    left_join(top_msas, by = "msa") %>%
    group_by(msa) %>%
    mutate(
      # Create unique random seed for each MSA
      msa_seed = cur_group_id(),
      # Smoother, more continuous variation using multiple sine waves
      time_factor = (year - 2015) / 8,  # Normalize to 0-1
      pop_growth_anim = pop_growth + 
        0.2 * sin(2 * pi * time_factor + msa_seed * 0.5) +
        0.15 * sin(4 * pi * time_factor + msa_seed * 0.3),
      gdp_growth_anim = gdp_growth + 
        0.25 * cos(2 * pi * time_factor + msa_seed * 0.4) +
        0.2 * cos(3 * pi * time_factor + msa_seed * 0.6),
      total_gdp = latest_gdp / 1000,  # Use actual income size
      msa_short = str_extract(msa, "^[^,]+")  # City name only
    ) %>%
    ungroup() %>%
    mutate(
      quadrant = case_when(
        gdp_growth_anim >= 0 & pop_growth_anim >= 0 ~ "Balanced Growth",
        gdp_growth_anim >= 0 & pop_growth_anim < 0  ~ "Productivity-Driven",
        gdp_growth_anim < 0 & pop_growth_anim >= 0  ~ "Demographic Pressure",
        TRUE                                        ~ "Declining/Restructuring"
      )
    )
  
  # Define color mapping using global chart_colors
  color_mapping <- c(
    "Balanced Growth" = as.character(chart_colors["Series1"]),
    "Productivity-Driven" = as.character(chart_colors["Series2"]),
    "Demographic Pressure" = as.character(chart_colors["Series3"]),
    "Declining/Restructuring" = as.character(chart_colors["Series4"])
  )
  
  # Build animation with optimized settings
  animated_plot <- plot_ly(
    data = animated_data,
    x = ~pop_growth_anim,
    y = ~gdp_growth_anim,
    size = ~total_gdp,
    color = ~quadrant,
    colors = color_mapping,
    text = ~msa_short,
    hoverinfo = "text",
    frame = ~year,
    type = "scatter",
    mode = "markers+text",
    textposition = "top center",
    textfont = list(size = 10),
    sizes = c(10, 55),
    marker = list(opacity = 0.7, line = list(width = 1, color = "gray50"))
  ) %>%
    layout(
      title = list(
        text = "Animated MSA Population vs Income Growth Matrix<br><sub>Marker size ∝ Median Household Income</sub>",
        x = 0.5,
        font = list(size = 18, family = "Arial", color = "#333F48")
      ),
      xaxis = list(title = "Population Growth (%)", zeroline = TRUE),
      yaxis = list(title = "Income Growth (%)", zeroline = TRUE),
      showlegend = FALSE
    ) %>%
    animation_opts(
      frame = 400,              
      transition = 350,         
      easing = "cubic-in-out",  
      redraw = FALSE,
      mode = "immediate"
    ) %>%
    animation_slider(
      currentvalue = list(
        prefix = "Year: ", 
        font = list(size = 14),
        xanchor = "center"
      ),
      steps = list(
        list(args = list(NULL, list(frame = list(duration = 400, redraw = FALSE),
                                   transition = list(duration = 350))),
             method = "animate")
      )
    ) %>%
    animation_button(
      x = 0, xanchor = "left", y = 1.15, yanchor = "top"
    )
  
  # Enable infinite looping
  animated_plot$x$layout$updatemenus[[1]]$buttons[[1]]$args[[2]]$loop <- TRUE
  
  animated_plot
  
} else {
  cat("**Note:** MSA data unavailable or incomplete for animation.")
}
```

------------------------------------------------------------------------

# Report Summary

This comprehensive macro monitor tracks **7 key dimensions of economic health** using exclusively free public data sources. All data is sourced from federal agencies (FRED, BLS, Census Bureau) and updated automatically when the report is regenerated.

## Data Sources Summary

**Primary API:** FRED (Federal Reserve Economic Data) - Requires free API key - Sections 1-6: All data available via FRED API - Section 7: Uses Census ACS (no API key) for MSA population and income growth

**Data Frequencies:** - Daily: Treasury rates, corporate spreads, VIX - Weekly: Initial unemployment claims - Monthly: Employment, retail sales, industrial production, construction - Quarterly: SLOOS lending standards, GDP, e-commerce % - Annual: MSA population and income data (ACS)

## To Run This Report

1.  **Install R and Quarto** (https://quarto.org)

2.  **Get API Keys (all free):**

``` bash
   # Create .Renviron file in your project directory
   FRED_API_KEY=your_fred_api_key_here
  OPENAI_API_KEY=your_openai_api_key_here  # Optional: auto-rewrite Current Status
  # No additional key needed for Section 7 (Census ACS)
```

3.  **Install Required Packages:**

``` r
   install.packages(c("tidyverse", "fredr", "lubridate", "scales", 
                      "knitr", "kableExtra", "plotly", "httr", 
                      "jsonlite", "zoo", "ggrepel"))
```

4.  **Render the Report:**

``` bash
   quarto render macro_monitor.qmd
```

## Customization Options

**Adjust lookback periods:** Modify date filters in chart creation **Add more MSAs:** Expand Section 7 to include all 393 MSAs **Change chart themes:** Modify ggplot2 theme settings **Export data tables:** Add CSV export functionality **Automate scheduling:** Use GitHub Actions or cron jobs for daily/weekly updates

------------------------------------------------------------------------

**Report generated:** `r Sys.time()` **Data cached in:** `data_cache/` directory (24-hour default cache)
