World Equity (Blended US + ex-US / VT) — Log-Trend & Super-Cycle Analysis | ERN historical data from 1971 + Yahoo Finance

chart_world.r

#!/usr/bin/env Rscript
# ═══════════════════════════════════════════════════════════════
# World Equity (Blended US + ex-US / VT) — Log-Trend & Super-Cycle
# Charts: 1_ Price+Trend, 2_ Deviation+Supertrend, 3_ Normalized
# Data: ERN SWR Toolbox (1871–2025) + Yahoo Finance (recent)
# Blend uses time-varying US market-cap weights (approx.)
# ═══════════════════════════════════════════════════════════════

library(tidyverse)
library(quantmod)
library(ggrepel)

sf <- 1.5
width <- 600 * sf
height <- 335 * sf
options(vsc.dev.args = list(width = width, height = height, res = 72 * sf))

# ── Configuration ─────────────────────────────────────────────
LABEL  <- "Stocks World (VT)"
PREFIX <- "chart_world"
START  <- as.Date("1871-01-01")

# ERN SWR Toolbox columns: 6 = S&P 500 TR, 10 = World ex-US
ERN_SHEET_ID <- "1QGrMm6XSGWBVLI8I_DOAeJV5whoCnSdmaR8toQB2Jz8"
YAHOO_TICKER <- "VT"  # Vanguard Total World for recent supplement

RED <- "#C62828"; ORANGE <- "#E65100"; AMBER <- "#F9A825"
GREEN <- "#2E7D32"; BLUE <- "#1565C0"; GRAY <- "#757575"; TEAL <- "#00695C"

# Supertrend
SUPER_CYCLE_YEARS_DEFAULT <- 40
LOESS_SPAN_MULT   <- 1.8
LOESS_MIN_SPAN    <- 0.12
LOESS_MAX_SPAN    <- 0.98
EDGE_DAMPEN_YEARS <- 12
EDGE_MIN_WEIGHT   <- 0.35
Z_BAND            <- 1.96

# ── Time-varying US weight (approximate market-cap share) ────
known_weights <- tibble(
  year   = c(1871, 1900, 1920, 1945, 1950, 1960, 1970, 1980, 1989,
             1995, 2000, 2005, 2010, 2015, 2020, 2025),
  us_pct = c(  15,   15,   35,   50,   50,   65,   65,   45,   30,
               40,   53,   45,   45,   55,   66,   72)
)

# ── Helper: parse ERN CSV numbers (comma thousands) ──────────
parse_num <- function(x) suppressWarnings(as.numeric(gsub(",", "", x)))

# ── Download ERN historical data ─────────────────────────────
cat("→ Downloading ERN SWR Toolbox (Asset Returns)...\n")
ern_url <- paste0(
  "https://docs.google.com/spreadsheets/d/", ERN_SHEET_ID,
  "/gviz/tq?tqx=out:csv&sheet=Asset+Returns"
)

ern_raw <- read_csv(ern_url, skip = 2, col_names = FALSE,
                    col_types = cols(.default = "c"), show_col_types = FALSE)

ern_df <- tibble(
  month      = parse_num(ern_raw[[1]]),
  year       = parse_num(ern_raw[[2]]),
  spx_tr     = parse_num(ern_raw[[6]]),
  world_exus = parse_num(ern_raw[[10]])
) |>
  filter(!is.na(month), !is.na(year),
         !is.na(spx_tr), spx_tr > 0,
         !is.na(world_exus), world_exus > 0) |>
  mutate(date = as.Date(sprintf("%04d-%02d-01",
                                as.integer(year), as.integer(month)))) |>
  arrange(date)

# ── Compute blended world index with time-varying US weight ──
cat("→ Blending US + ex-US with time-varying weights...\n")

all_years <- tibble(year = min(ern_df$year):max(ern_df$year))
weights <- all_years |>
  mutate(us_wt = approx(known_weights$year, known_weights$us_pct / 100,
                         year, rule = 2)$y)

blend_df <- ern_df |>
  mutate(
    ret_spx   = spx_tr / lag(spx_tr) - 1,
    ret_world = world_exus / lag(world_exus) - 1
  ) |>
  filter(!is.na(ret_spx), !is.na(ret_world)) |>
  left_join(weights, by = "year") |>
  mutate(
    ret_blend = us_wt * ret_spx + (1 - us_wt) * ret_world,
    close     = cumprod(1 + ret_blend) * 100
  ) |>
  filter(date >= START) |>
  transmute(date, close) |>
  arrange(date)

cat("  Blended data:", nrow(blend_df), "months,",
    format(min(blend_df$date)), "to", format(max(blend_df$date)), "\n")

# ── Supplement with recent Yahoo Finance data ─────────────────
cat("→ Supplementing with Yahoo Finance (", YAHOO_TICKER, ")...\n")
last_blend <- tail(blend_df, 1)

tryCatch({
  raw <- getSymbols(YAHOO_TICKER, from = last_blend$date - 60,
                    to = Sys.Date(), auto.assign = FALSE)
  yahoo_m <- tibble(
    date  = as.Date(index(raw)),
    close = as.numeric(Ad(raw))
  ) |>
    filter(!is.na(close), close > 0) |>
    mutate(ym = floor_date(date, "month")) |>
    group_by(ym) |> slice_tail(n = 1) |> ungroup() |>
    transmute(date = ym, close) |> arrange(date)

  overlap <- yahoo_m |> filter(date == last_blend$date)
  if (nrow(overlap) == 0) {
    overlap <- yahoo_m |>
      mutate(diff = abs(as.numeric(date - last_blend$date))) |>
      filter(diff <= 45) |> arrange(diff) |> slice(1) |> select(-diff)
  }
  if (nrow(overlap) == 1) {
    scale_f <- last_blend$close / overlap$close
    yahoo_new <- yahoo_m |>
      filter(date > last_blend$date) |>
      mutate(close = close * scale_f)
    if (nrow(yahoo_new) > 0) {
      blend_df <- bind_rows(blend_df, yahoo_new)
      cat("  Added", nrow(yahoo_new), "months from Yahoo.\n")
    }
  }
}, error = \(e) cat("  Yahoo supplement failed:", e$message, "\n"))

df <- blend_df |> arrange(date)
cat("  Final:", nrow(df), "months,",
    format(min(df$date)), "to", format(max(df$date)), "\n")

# ── Log-linear trend ─────────────────────────────────────────
df <- df |> mutate(date_num = as.numeric(date), log_close = log(close))
fit <- lm(log_close ~ date_num, data = df)
cagr <- (exp(coef(fit)[2] * 365.25) - 1) * 100

df <- df |> mutate(
  trend   = exp(predict(fit, newdata = pick(everything()))),
  pct_dev = (close - trend) / trend * 100
)
cat("  Trend CAGR:", round(cagr, 2), "%/yr\n")

# ── Supertrend (edge-adaptive LOESS) ─────────────────────────
data_years <- as.numeric(difftime(max(df$date), min(df$date),
                                  units = "days")) / 365.25
cycle_years <- if (data_years >= 50) {
  SUPER_CYCLE_YEARS_DEFAULT
} else {
  max(8, round(data_years * 0.4))
}
k_months <- as.integer(cycle_years * 12)
n <- nrow(df)
span <- min(LOESS_MAX_SPAN, max(LOESS_MIN_SPAN,
                                LOESS_SPAN_MULT * k_months / n))

t_idx <- seq_len(n)
edge_n <- min(as.integer(EDGE_DAMPEN_YEARS * 12), floor(n / 2))
w <- rep(1, n)
if (edge_n >= 2) {
  ramp <- seq(EDGE_MIN_WEIGHT, 1, length.out = edge_n)
  w[seq_len(edge_n)] <- ramp
  w[(n - edge_n + 1):n] <- rev(ramp)
}

lo <- loess(df$pct_dev ~ t_idx, span = span, degree = 1,
            family = "symmetric", weights = w,
            control = loess.control(surface = "direct"))
df$supertrend <- as.numeric(predict(lo, data.frame(t_idx = t_idx)))
df$norm_dev   <- df$pct_dev - df$supertrend

cat("  Supertrend:", cycle_years, "yr cycle, span =", round(span, 3), "\n")

# ── Label helper ──────────────────────────────────────────────
decade_labels <- function(dates, values, threshold = 20) {
  tbl <- tibble(date = dates, val = values) |>
    mutate(decade = floor(year(date) / 10) * 10) |>
    group_by(decade) |>
    summarize(
      max_d = date[which.max(val)], max_v = max(val),
      min_d = date[which.min(val)], min_v = min(val),
      .groups = "drop"
    )
  bind_rows(
    tbl |> filter(abs(max_v) >= threshold) |>
      transmute(date = max_d, val = max_v),
    tbl |> filter(abs(min_v) >= threshold) |>
      transmute(date = min_d, val = min_v)
  ) |> distinct(date, .keep_all = TRUE)
}

last_str <- format(max(df$date), "%b %Y")
cur <- tail(df, 1)

# ═══════════════════════════════════════════════════════════════
# Chart 1_: Price (log scale) with Log-Trend
# ═══════════════════════════════════════════════════════════════
cat("→ Chart 1: Price + Trend\n")

extrema1 <- bind_rows(
  decade_labels(df$date, df$pct_dev, 20),
  tibble(date = cur$date, val = cur$pct_dev)
) |> distinct(date, .keep_all = TRUE) |>
  left_join(df |> select(date, close), by = "date")

p1 <- ggplot(df, aes(x = date)) +
  geom_ribbon(aes(ymin = pmin(close, trend), ymax = trend),
              fill = GREEN, alpha = 0.15) +
  geom_ribbon(aes(ymin = trend,
                  ymax = pmin(pmax(close, trend), trend * 1.6)),
              fill = AMBER, alpha = 0.12) +
  geom_ribbon(aes(ymin = trend * 1.6,
                  ymax = pmax(close, trend * 1.6)),
              fill = RED, alpha = 0.18) +
  geom_line(aes(y = close), color = BLUE, linewidth = 0.5) +
  geom_line(aes(y = trend), color = "black", linetype = "dashed",
            linewidth = 0.5) +
  geom_point(data = extrema1, aes(x = date, y = close),
             color = ORANGE, size = 2) +
  geom_text_repel(data = extrema1,
    aes(x = date, y = close, label = sprintf("%+.0f%%", val)),
    color = BLUE, size = 2.8, nudge_y = 0.15,
    max.overlaps = 15, seed = 42) +
  scale_x_date(date_breaks = "10 year", date_labels = "%Y") +
  scale_y_continuous(trans = "log2",
    labels = scales::label_number(scale_cut = scales::cut_short_scale())) +
  labs(
    title = paste0(LABEL, " (Log Scale)"),
    subtitle = paste0("Since ", format(min(df$date), "%Y"),
      " | Trend CAGR ~ ", round(cagr, 1),
      "%/yr | Time-varying US/ex-US cap weights"),
    x = NULL, y = "Index Level",
    caption = "Source: ERN SWR Toolbox + Yahoo Finance (VT). Blend: S&P 500 TR + World ex-US with historical market-cap weights."
  ) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 30, hjust = 1),
        legend.position = "none")

ggsave(paste0(PREFIX, "_1_price.png"), p1,
       width = width / 72 / sf, height = height / 72 / sf, dpi = 72 * sf)

# ═══════════════════════════════════════════════════════════════
# Chart 2_: Deviation from Log-Trend + Supertrend
# ═══════════════════════════════════════════════════════════════
cat("→ Chart 2: Deviation + Supertrend\n")

lbl2 <- bind_rows(
  decade_labels(df$date, df$pct_dev, 20),
  tibble(date = cur$date, val = cur$pct_dev)
) |> distinct(date, .keep_all = TRUE)

p2 <- ggplot(df, aes(date, pct_dev)) +
  geom_ribbon(aes(ymin = pmin(pct_dev, 0), ymax = 0),
              fill = GREEN, alpha = 0.15) +
  geom_ribbon(aes(ymin = 0, ymax = pmin(pmax(pct_dev, 0), 60)),
              fill = AMBER, alpha = 0.12) +
  geom_ribbon(aes(ymin = 60, ymax = pmax(pct_dev, 60)),
              fill = RED, alpha = 0.18) +
  geom_hline(yintercept = 0, linetype = "dashed", linewidth = 0.4) +
  geom_line(color = BLUE, linewidth = 0.4, alpha = 0.6) +
  geom_line(aes(y = supertrend), color = TEAL, linewidth = 0.8) +
  geom_point(data = lbl2, aes(y = val), color = ORANGE, size = 1.8) +
  geom_text_repel(
    data = lbl2 |> mutate(
      lbl = if_else(date == max(date),
        paste0(last_str, ": ", sprintf("%+.0f%%", val)),
        sprintf("%+.0f%%", val))),
    aes(y = val, label = lbl),
    color = BLUE, size = 2.8, fontface = "bold",
    nudge_y = 5, box.padding = 0.5, max.overlaps = 15, seed = 42
  ) +
  scale_x_date(date_breaks = "10 year", date_labels = "%Y") +
  scale_y_continuous(labels = \(x) paste0(x, "%"),
                     breaks = seq(-60, 120, 20)) +
  labs(
    title = paste0(LABEL, ": Deviation from Log-Trend + Supertrend"),
    subtitle = paste0(
      "Trend CAGR ~ ", round(cagr, 1), "%/yr  |  Teal = ",
      cycle_years, "yr supertrend (edge-adaptive LOESS)"),
    x = NULL, y = "Deviation from trend (%)",
    caption = "Source: ERN SWR Toolbox + Yahoo Finance (VT). Supertrend: robust LOESS with edge down-weighting."
  ) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 30, hjust = 1),
        legend.position = "none")

ggsave(paste0(PREFIX, "_2_deviation.png"), p2,
       width = width / 72 / sf, height = height / 72 / sf, dpi = 72 * sf)

# ═══════════════════════════════════════════════════════════════
# Chart 3_: Double-Normalized (deviation minus supertrend)
# ═══════════════════════════════════════════════════════════════
cat("→ Chart 3: Double-Normalized\n")

norm_sd <- sd(df$norm_dev, na.rm = TRUE)
band <- Z_BAND * norm_sd

lbl3 <- bind_rows(
  decade_labels(df$date, df$norm_dev, 15),
  tibble(date = cur$date, val = cur$norm_dev)
) |> distinct(date, .keep_all = TRUE)

p3 <- ggplot(df, aes(date, norm_dev)) +
  geom_ribbon(aes(ymin = pmin(norm_dev, 0), ymax = 0),
              fill = GREEN, alpha = 0.15) +
  geom_ribbon(aes(ymin = 0, ymax = pmin(pmax(norm_dev, 0), band)),
              fill = AMBER, alpha = 0.12) +
  geom_ribbon(aes(ymin = band, ymax = pmax(norm_dev, band)),
              fill = RED, alpha = 0.18) +
  geom_hline(yintercept = 0, linetype = "dashed", linewidth = 0.4) +
  geom_hline(yintercept = c(-band, band), color = GRAY,
             linetype = "dotted", linewidth = 0.35) +
  geom_line(color = BLUE, linewidth = 0.5) +
  geom_point(data = lbl3, aes(y = val), color = ORANGE, size = 1.8) +
  geom_text_repel(
    data = lbl3 |> mutate(
      lbl = if_else(date == max(date),
        paste0(last_str, ": ", sprintf("%+.0f%%", val)),
        sprintf("%+.0f%%", val))),
    aes(y = val, label = lbl),
    color = BLUE, size = 2.8, fontface = "bold",
    nudge_y = 3, box.padding = 0.4, max.overlaps = 20, seed = 42
  ) +
  scale_x_date(date_breaks = "5 year", date_labels = "%Y") +
  scale_y_continuous(labels = \(x) paste0(x, "%")) +
  labs(
    title = paste0(LABEL, ": Double-Normalized (Log + Supertrend)"),
    subtitle = paste0(
      "Deviation minus ", cycle_years,
      "yr supertrend  |  Dotted = +/-", Z_BAND, " SD"),
    x = NULL, y = "Normalized deviation (%)",
    caption = "Source: ERN SWR Toolbox + Yahoo Finance (VT). Cyclical over/undervaluation after removing secular trend."
  ) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 30, hjust = 1),
        legend.position = "none")

ggsave(paste0(PREFIX, "_3_normalized.png"), p3,
       width = width / 72 / sf, height = height / 72 / sf, dpi = 72 * sf)

cat("\n✓ Saved:", paste0(PREFIX, c("_1_price.png", "_2_deviation.png",
                                   "_3_normalized.png")), "\n")