# Sector Momentum Breakout & Rotation -- R / quantstrat
# Analysis & validation code: benchmarks, risk diagnostics, cash overlay,
# parameter optimization, walk-forward validation.
# Run sector-momentum-R-strategy.R first, in the same R session.
# Full notebook: https://quantstr.at/wp-content/uploads/reports/sector-momentum-R.html

library(ggplot2)

strategy_eq <- getAccount(account.st)$summary$End.Eq

spy <- getSymbols("SPY", from = start_date, to = end_date, auto.assign = FALSE, src = "yahoo", adjust = TRUE)
spy_eq <- init_equity * Cl(spy) / as.numeric(Cl(spy)[1])

basket_eq <- Reduce(`+`, lapply(symbols, function(s) {
  px <- Cl(get(s))
  (init_equity / length(symbols)) * px / as.numeric(px[1])
}))

comparison <- merge(strategy_eq, spy_eq, basket_eq, join = "inner")
colnames(comparison) <- c("Strategy", "SPY", "Sector_Basket")

plot(as.zoo(comparison), plot.type = "single", col = c("#00E08F", "#F59E0B", "#2563EB"),
     lwd = 2, xlab = "", ylab = "Equity ($)", main = "Strategy vs. Benchmark Equity Curves")
legend("topleft", legend = colnames(comparison), col = c("#00E08F", "#F59E0B", "#2563EB"), lwd = 2, bty = "n")

# Mark-to-market identity: cash = init equity + cumulative realized P&L +
# fees - cost basis of currently open positions. This reconciles exactly to
# blotter's own End.Eq to ~1e-10 precision -- it is not an approximation.
pos_value <- Reduce(`+`, lapply(symbols, function(s) getPortfolio(portfolio.st)$symbols[[s]]$posPL.USD$Pos.Value))
cost_basis <- Reduce(`+`, lapply(symbols, function(s) {
  p <- getPortfolio(portfolio.st)$symbols[[s]]$posPL.USD
  p$Pos.Qty * p$Pos.Avg.Cost
}))
realized_cum <- Reduce(`+`, lapply(symbols, function(s) cumsum(getPortfolio(portfolio.st)$symbols[[s]]$posPL.USD$Period.Realized.PL)))
fees_cum <- Reduce(`+`, lapply(symbols, function(s) cumsum(getPortfolio(portfolio.st)$symbols[[s]]$posPL.USD$Txn.Fees)))

cash <- init_equity + realized_cum + fees_cum - cost_basis
exposure_pct <- 100 * (1 - cash / (cash + pos_value))

plot(as.zoo(exposure_pct), col = "#00E08F", lwd = 1.5,
     xlab = "", ylab = "% of Equity Invested", main = "Portfolio Exposure Over Time")
abline(h = 0, lty = 2, col = "gray60")
cat(sprintf("Average invested exposure (mark-to-market): %.1f%%\n", mean(as.numeric(exposure_pct))))

bh_returns <- sapply(symbols, function(s) {
  px <- as.numeric(Cl(get(s)))
  (px[length(px)] / px[1] - 1) * 100
})

# BIL = 1-3 month T-Bill ETF (near-zero duration -- the realistic way to
# "hold T-bills" through a brokerage); BND = intermediate-duration bonds;
# TLT = long-duration Treasuries. Duration turns out to matter far more
# than the flat-yield assumption commonly used for this kind of estimate.
n <- length(cash)
cash_num <- as.numeric(cash)
posval_num <- as.numeric(pos_value)
dates <- as.Date(index(cash))

bond_overlay <- function(bond_symbol) {
  bond <- getSymbols(bond_symbol, from = start_date, to = end_date, auto.assign = FALSE, src = "yahoo", adjust = TRUE)
  bond_ret_df <- data.frame(date = as.Date(index(bond)), ret = as.numeric(dailyReturn(Cl(bond))))
  merged <- merge(data.frame(date = dates), bond_ret_df, by = "date", all.x = TRUE)
  merged$ret[is.na(merged$ret)] <- 0
  cash_flow <- c(0, diff(cash_num))
  cash_bond <- numeric(n); cash_bond[1] <- cash_num[1]
  for (i in 2:n) cash_bond[i] <- cash_bond[i - 1] * (1 + merged$ret[i]) + cash_flow[i]
  new_equity <- xts(cash_bond + posval_num, order.by = dates)
  ret <- dailyReturn(new_equity)
  c(total_return = (cash_bond[n] + posval_num[n]) / init_equity * 100 - 100,
    sharpe = as.numeric(SharpeRatio.annualized(ret, Rf = 0)),
    max_dd = as.numeric(maxDrawdown(ret)) * 100)
}

overlay_results <- rbind(Baseline = c(total_return = total_ret_pct, sharpe = sharpe, max_dd = maxdd_pct),
                          BIL = bond_overlay("BIL"), BND = bond_overlay("BND"), TLT = bond_overlay("TLT"))

strategy_ret <- dailyReturn(getAccount(account.st)$summary$End.Eq)
table.DownsideRisk(strategy_ret)

table.Drawdowns(strategy_ret, top = 5)

rolling_sharpe <- rollapply(strategy_ret, width = 63,
                             FUN = function(x) as.numeric(SharpeRatio.annualized(x, Rf = 0)),
                             by.column = FALSE, align = "right")
plot(rolling_sharpe, main = "Rolling 3-Month Annualized Sharpe Ratio")

chart.Posn(portfolio.st, Symbol = "XLK", TA = "add_SMA(n = 10, col = 'blue'); add_SMA(n = 30, col = 'red')")

charts.PerformanceSummary(strategy_ret, main = "Strategy Performance Summary")

fast_grid <- c(5, 10, 15, 20)
slow_grid <- c(20, 30, 40, 50)
combos <- expand.grid(fast_n = fast_grid, slow_n = slow_grid)
combos <- combos[combos$fast_n < combos$slow_n, ]
k_train <- 18   # months of training data per walk-forward window
k_test  <- 6    # months of out-of-sample testing per walk-forward window

wf_end_date <- Sys.Date()
for (sym in symbols) {
  assign(sym, getSymbols(sym, from = start_date, to = wf_end_date, auto.assign = FALSE, src = "yahoo", adjust = TRUE), envir = .GlobalEnv)
}
for (sym in c("XLK", "XLE", "XLY")) {
  raw <- getSymbols(sym, from = start_date, to = wf_end_date, auto.assign = FALSE, src = "yahoo", adjust = FALSE)
  adj <- get(sym)
  raw_cl <- as.numeric(Cl(raw)); adj_cl <- as.numeric(Cl(adj))
  ratio <- adj_cl / raw_cl
  ratio_change <- c(NA, diff(ratio) / head(ratio, -1))
  jump_idx <- which(abs(ratio_change) > 0.3)
  if (length(jump_idx) > 0) {
    j <- jump_idx[1]
    correction_factor <- ratio[j] / ratio[j - 1]
    corrected <- adj
    corrected[1:(j - 1), ] <- adj[1:(j - 1), ] * correction_factor
    assign(sym, corrected, envir = .GlobalEnv)
  }
}

base_strategy <- getStrategy(strategy.st)

# rule.subset  = dates on which entry/exit RULES may fire
# update_dates = dates through which positions are marked to market
#                (this is what keeps training scores free of look-ahead bias)
run_backtest <- function(fast_n, slow_n, rule.subset, update_dates,
                         portfolio_name, carry_forward = FALSE) {
  strat <- base_strategy
  for (i in seq_along(strat$indicators)) {
    if (strat$indicators[[i]]$label == "ema10") strat$indicators[[i]]$arguments$n <- fast_n
    if (strat$indicators[[i]]$label == "ema30") strat$indicators[[i]]$arguments$n <- slow_n
  }
  if (!carry_forward) {
    suppressWarnings(try(rm.strat(portfolio_name), silent = TRUE))
    initPortf(portfolio_name, symbols = symbols, initDate = start_date, currency = "USD")
    initOrders(portfolio_name, initDate = start_date)
    for (sym in symbols) addPosLimit(portfolio_name, sym, timestamp = start_date, maxpos = 300)
  }
  applyStrategy(strat, portfolios = portfolio_name, rule.subset = rule.subset)
  updatePortf(portfolio_name, Dates = update_dates)
  invisible(NULL)
}

# Total net P&L over exactly the dates that were updated (no future prices)
objective <- function(portfolio_name) {
  sum(as.numeric(getPortfolio(portfolio_name)$summary$Net.Trading.PL), na.rm = TRUE)
}

opt_portfolio.st <- "blog_portfolio_opt"
full_span <- paste(start_date, end_date, sep = "/")
opt_results <- data.frame()
for (k in seq_len(nrow(combos))) {
  run_backtest(combos$fast_n[k], combos$slow_n[k], rule.subset = full_span, update_dates = full_span,
               portfolio_name = opt_portfolio.st)
  opt_results <- rbind(opt_results, data.frame(fast_n = combos$fast_n[k], slow_n = combos$slow_n[k],
                                                Net.Trading.PL = objective(opt_portfolio.st)))
}
opt_results_sorted <- opt_results[order(-opt_results$Net.Trading.PL), ]

all_dates <- index(get(symbols[1]))
n_dates <- length(all_dates)
ep <- endpoints(all_dates, on = "months")
windows <- data.frame()
w <- 1
while ((k_train + 1 + (w - 1) * k_test) <= length(ep)) {
  tr_start <- 1 + ep[(w - 1) * k_test + 1]
  tr_end   <- ep[k_train + 1 + (w - 1) * k_test]
  te_start <- tr_end + 1
  te_end   <- if ((k_train + 1 + w * k_test) <= length(ep)) ep[k_train + 1 + w * k_test] else n_dates
  if (te_start > n_dates) break
  windows <- rbind(windows, data.frame(training.start = all_dates[tr_start], training.end = all_dates[tr_end],
                                        testing.start = all_dates[te_start], testing.end = all_dates[te_end]))
  w <- w + 1
}

wf_portfolio.st <- "blog_portfolio_wf"
suppressWarnings(try(rm.strat(wf_portfolio.st), silent = TRUE))
initPortf(wf_portfolio.st, symbols = symbols, initDate = start_date, currency = "USD")
initOrders(wf_portfolio.st, initDate = start_date)
for (sym in symbols) addPosLimit(wf_portfolio.st, sym, timestamp = start_date, maxpos = 300)

chosen_combos <- data.frame()
for (w in seq_len(nrow(windows))) {
  train_span  <- paste(windows$training.start[w], windows$training.end[w], sep = "/")
  train_marks <- paste(start_date, windows$training.end[w], sep = "/")
  test_span   <- paste(windows$testing.start[w], windows$testing.end[w], sep = "/")
  test_marks  <- paste(start_date, windows$testing.end[w], sep = "/")

  best_obj <- -Inf; best_combo <- NULL
  for (k in seq_len(nrow(combos))) {
    train_port <- sprintf("train_w%d_%d_%d", w, combos$fast_n[k], combos$slow_n[k])
    run_backtest(combos$fast_n[k], combos$slow_n[k], rule.subset = train_span, update_dates = train_marks,
                 portfolio_name = train_port)
    obj <- objective(train_port)
    if (is.finite(obj) && obj > best_obj) {
      best_obj <- obj
      best_combo <- c(fast_n = combos$fast_n[k], slow_n = combos$slow_n[k])
    }
  }
  chosen_combos <- rbind(chosen_combos, data.frame(window = w, fast_n = best_combo[["fast_n"]],
                                                    slow_n = best_combo[["slow_n"]], train_pl = best_obj))

  run_backtest(best_combo[["fast_n"]], best_combo[["slow_n"]], rule.subset = test_span, update_dates = test_marks,
               portfolio_name = wf_portfolio.st, carry_forward = TRUE)
}

oos_stats <- tradeStats(wf_portfolio.st)

live_start <- min(windows$testing.start)
oos_end    <- max(windows$testing.end)
oos_span   <- paste(live_start, oos_end, sep = "/")
oos_marks  <- paste(start_date, oos_end, sep = "/")

perf_stats <- function(values, dates) {
  keep <- dates >= live_start & dates <= oos_end
  v <- as.numeric(values)[keep]
  r <- xts(diff(v) / head(v, -1), order.by = dates[keep][-1])
  data.frame(Total_Return_Pct = (v[length(v)] / v[1] - 1) * 100,
             Ann_Sharpe       = as.numeric(SharpeRatio.annualized(r, Rf = 0)),
             Max_Drawdown_Pct = min(v / cummax(v) - 1) * 100)
}
equity_of <- function(portfolio_name) {
  s <- getPortfolio(portfolio_name)$summary
  list(values = init_equity + cumsum(as.numeric(s$Net.Trading.PL)), dates = as.Date(index(s)))
}

wf_e <- equity_of(wf_portfolio.st)

# Reference A: the fixed EMA 10/30 rule from the main backtest (chosen in advance, never tuned), same dates
run_backtest(10, 30, rule.subset = oos_span, update_dates = oos_marks, portfolio_name = "oos_fixed_1030")
fixed_e <- equity_of("oos_fixed_1030")

# Reference B: the BEST fixed combo *for this exact out-of-sample period* --
# chosen with full hindsight, so it is an upper bound nobody could have known in advance.
hind <- data.frame()
for (k in seq_len(nrow(combos))) {
  run_backtest(combos$fast_n[k], combos$slow_n[k], rule.subset = oos_span, update_dates = oos_marks, portfolio_name = "oos_hind")
  he <- equity_of("oos_hind")
  hind <- rbind(hind, data.frame(fast_n = combos$fast_n[k], slow_n = combos$slow_n[k],
                                  final_eq = he$values[length(he$values)]))
}
hb <- hind[which.max(hind$final_eq), ]
run_backtest(hb$fast_n, hb$slow_n, rule.subset = oos_span, update_dates = oos_marks, portfolio_name = "oos_hind")
hind_e <- equity_of("oos_hind")

spy_wf <- getSymbols("SPY", from = start_date, to = wf_end_date, auto.assign = FALSE, src = "yahoo", adjust = TRUE)
spy_dates <- as.Date(index(spy_wf)); spy_close <- as.numeric(Cl(spy_wf))
basket_dates <- as.Date(index(get(symbols[1])))
base_i <- which(basket_dates >= live_start)[1]
basket_index <- rowMeans(sapply(symbols, function(s) as.numeric(Cl(get(s))) / as.numeric(Cl(get(s)))[base_i]))

wf_comparison <- rbind(
  cbind(Strategy = "Walk-forward (out-of-sample)",        perf_stats(wf_e$values, wf_e$dates)),
  cbind(Strategy = "Fixed EMA 10/30 (baseline rule)",     perf_stats(fixed_e$values, fixed_e$dates)),
  cbind(Strategy = sprintf("Hindsight-best fixed %d/%d (unattainable live)", hb$fast_n, hb$slow_n),
        perf_stats(hind_e$values, hind_e$dates)),
  cbind(Strategy = "SPY buy & hold",                      perf_stats(spy_close, spy_dates)),
  cbind(Strategy = "Equal-weight sector basket",          perf_stats(basket_index, basket_dates))
)
wf_comparison[, -1] <- round(wf_comparison[, -1], 2)

cat(sprintf("Walk-forward out-of-sample net P&L: $%.0f (%.1f%% vs. SPY %.1f%%, sector basket %.1f%%) over %s to %s\n",
            sum(oos_stats$Net.Trading.PL, na.rm = TRUE), wf_comparison$Total_Return_Pct[1],
            wf_comparison$Total_Return_Pct[4], wf_comparison$Total_Return_Pct[5], live_start, oos_end))

d <- wf_e$dates[wf_e$dates >= live_start & wf_e$dates <= oos_end]
rebase <- function(x) x / x[1] * 100 - 100
on_grid <- function(values, dates) approx(x = as.numeric(dates), y = as.numeric(values), xout = as.numeric(d), rule = 2)$y
series <- list(
  wf     = rebase(on_grid(wf_e$values, wf_e$dates)),
  fixed  = rebase(on_grid(fixed_e$values, fixed_e$dates)),
  spy    = rebase(on_grid(spy_close, spy_dates)),
  basket = rebase(on_grid(basket_index, basket_dates))
)
y_range <- range(unlist(series))
plot(d, series$wf, type = "n", xlab = "", ylab = "Cumulative Return (%)", ylim = y_range,
     main = "Walk-Forward Out-of-Sample Return vs. Benchmarks (same start date)")
abline(v = windows$testing.start, col = "gray75", lty = 3)
text(windows$testing.start, y_range[1], labels = paste0(chosen_combos$fast_n, "/", chosen_combos$slow_n),
     adj = c(-0.1, -0.5), cex = 0.7, col = "gray35")
lines(d, series$spy,    col = "#F59E0B", lwd = 2)
lines(d, series$basket, col = "#2563EB", lwd = 2)
lines(d, series$fixed,  col = "gray45",  lwd = 2, lty = 2)
lines(d, series$wf,     col = "#00E08F", lwd = 3)
legend("topleft", bg = "white", box.col = "gray80", cex = 0.85, lwd = c(3, 2, 2, 2), lty = c(1, 2, 1, 1),
       col = c("#00E08F", "gray45", "#F59E0B", "#2563EB"),
       legend = c("Walk-forward (params re-chosen each window)", "Fixed EMA 10/30 (baseline rule)",
                  "SPY Buy & Hold", "Sector Basket Buy & Hold"))
mtext("Dotted vertical lines = re-optimization dates; labels = fast/slow EMA chosen from the preceding training window",
      side = 1, line = 2.5, cex = 0.7, col = "gray35")