R / quantstrat Research Notebook — Full Backtest, Risk Analysis, Parameter Optimization & Walk-Forward Validation
Get the code: Download Strategy Code (.R) | Download Analysis & Validation Code (.R)
Known data-quality limitation (XLK, XLE, XLY). R and the companion Python notebook both source prices from Yahoo Finance, and the raw (unadjusted) prices the two pull are identical. However, quantmod’s split/dividend-adjusted close for these three symbols contains a discontinuity: the dividend-adjustment ratio jumps abruptly on 2025-12-05 with no corresponding move in the raw price, rather than varying smoothly day to day the way a real dividend adjustment does. The companion Python notebook’s data source (yfinance) does not exhibit this discontinuity for the same symbols and dates.
The data-cleaning step below corrects the resulting price discontinuity (a single rescale of the affected segment), which is what keeps this notebook’s indicators and trade signals well-behaved. It is a targeted fix for the jump, not a full reconstruction of a smoothly-varying dividend adjustment — so buy-and-hold and total-return figures for these three symbols, especially the higher-dividend-yield ones (XLE in particular), may be modestly overstated here relative to the Python notebook’s equivalent figures. Strategy-level results (entries, exits, the headline backtest) are far less affected than single-symbol buy-and-hold figures, since the correction only shifts the pre-cutoff price level, not the day-to-day return pattern signals are computed from.
This is left as-is for now and may be revisited with a better-behaved data source later.
This notebook is a complete, self-contained, executable replication of the Sector Momentum Breakout & Rotation strategy published at quantstr.at. Every number, table, and chart below is generated by the R code in this document at render time — nothing is pasted in from the live article. Re-running this notebook end to end (quarto render sector-momentum-R.qmd) reproduces every result from scratch against freshly downloaded market data.
The strategy trades six liquid U.S. sector ETFs — Technology (XLK), Financials (XLF), Industrials (XLI), Energy (XLE), Health Care (XLV), and Consumer Discretionary (XLY) — using a trend-following rule: go long a sector when its 10-day EMA crosses above its 30-day EMA while 14-day RSI is above 50, and exit when the 10-day EMA crosses back below the 30-day EMA.
This notebook first builds and runs the strategy exactly as specified — a single, fixed-parameter backtest over a fixed 3-year window — then goes further than the public article by stress-testing the strategy’s design, not just its performance, with a parameter grid search and a walk-forward validation.
Reproducibility note. The backtest section below uses a fixed historical window so its results are stable and repeatable. The walk-forward section later on deliberately extends through today’s date at render time, so its out-of-sample results will differ slightly each time this notebook is re-rendered — that is intentional, not a bug: a genuine walk-forward keeps accumulating new out-of-sample evidence as time passes.
suppressPackageStartupMessages({
library(blotter)
library(quantstrat)
library(PerformanceAnalytics)
library(TTR)
library(gt)
})
Sys.setenv(TZ = "UTC")
# gt::currency() would otherwise mask FinancialInstrument::currency() once
# gt is loaded, so this one call stays namespace-qualified.
FinancialInstrument::currency("USD")[1] "USD"R 4.5.0 | quantstrat 0.25 | blotter 0.17.0 | PerformanceAnalytics 2.0.8symbols <- c("XLK", "XLF", "XLI", "XLE", "XLV", "XLY")
start_date <- "2023-08-29"
end_date <- "2026-08-27"
init_equity <- 100000
stock(symbols, currency = "USD", multiplier = 1)[1] "XLK" "XLF" "XLI" "XLE" "XLV" "XLY"A fixed 3-year window (2023-08-29 to 2026-08-27) keeps headline results stable and comparable across runs. Starting capital is $100,000.
Price history for all six ETFs is downloaded from Yahoo Finance and lightly cleaned before use:
# Some Yahoo Finance split-adjusted histories contain a spurious
# adjustment factor applied before a given cutoff date that does not
# correspond to any real split in the raw (unadjusted) price series.
# This block detects and removes any such phantom adjustment factor
# before running the strategy.
affected_symbols <- c("XLK", "XLE", "XLY")
fix_symbol <- function(sym) {
raw <- getSymbols(sym, from = start_date, to = end_date, auto.assign = FALSE, src = "yahoo", adjust = FALSE)
adj <- getSymbols(sym, from = start_date, to = end_date, auto.assign = FALSE, src = "yahoo", adjust = TRUE)
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) return(adj)
j <- jump_idx[1]
correction_factor <- ratio[j] / ratio[j - 1]
corrected <- adj
corrected[1:(j - 1), ] <- adj[1:(j - 1), ] * correction_factor
corrected
}
for (sym in affected_symbols) {
assign(sym, fix_symbol(sym), envir = .GlobalEnv)
}
for (sym in setdiff(symbols, affected_symbols)) {
assign(sym, getSymbols(sym, from = start_date, to = end_date, auto.assign = FALSE, src = "yahoo", adjust = TRUE), envir = .GlobalEnv)
}Bars downloaded per symbol:XLK XLF XLI XLE XLV XLY
751 751 751 751 751 751 portfolio.st <- "blog_portfolio"
account.st <- "blog_account"
strategy.st <- "blog_strategy"
suppressWarnings(try(rm.strat(portfolio.st), silent = TRUE))
suppressWarnings(try(rm.strat(account.st), silent = TRUE))
suppressWarnings(try(rm.strat(strategy.st), silent = TRUE))
initPortf(portfolio.st, symbols = symbols, initDate = start_date, currency = "USD")
initAcct(account.st, portfolios = portfolio.st, initDate = start_date, currency = "USD", initEq = init_equity)
initOrders(portfolio.st, initDate = start_date)
strategy(strategy.st, store = TRUE)
for (sym in symbols) {
addPosLimit(portfolio.st, sym, timestamp = start_date, maxpos = 300)
}Each sector ETF is capped at 300 units per position (roughly 16.7% of starting equity per sector at typical 2023-2026 prices), and every order is a fixed 300-share market order — not a dynamically rebalanced percentage of equity. This matters later: it means the strategy’s exposure can legitimately exceed 100% of starting equity if several sectors are held simultaneously after gains compound, which shows up clearly in the exposure chart below.
# Indicators: 10-day EMA, 30-day EMA, 14-day RSI
add.indicator(strategy.st, name = "EMA", arguments = list(x = quote(Cl(mktdata)), n = 10), label = "ema10")
add.indicator(strategy.st, name = "EMA", arguments = list(x = quote(Cl(mktdata)), n = 30), label = "ema30")
add.indicator(strategy.st, name = "RSI", arguments = list(price = quote(Cl(mktdata)), n = 14), label = "rsi14")
# Signals
add.signal(strategy.st, name = "sigComparison", arguments = list(columns = c("ema10", "ema30"), relationship = "gt"), label = "ema_gt")
add.signal(strategy.st, name = "sigCrossover", arguments = list(columns = c("ema10", "ema30"), relationship = "lt"), label = "bearish_ema_cross")
add.signal(strategy.st, name = "sigThreshold", arguments = list(column = "rsi14", threshold = 50, relationship = "gt"), label = "rsi_gt_50")
add.signal(strategy.st, name = "sigFormula", arguments = list(formula = "ema_gt & rsi_gt_50", cross = TRUE), label = "entry_signal")
# Rules: T+1 open fill, 5 bps slippage, fixed 300-share size, replace-on-exit
add.rule(strategy.st, name = "ruleSignal",
arguments = list(sigcol = "entry_signal", sigval = TRUE,
orderqty = 300, ordertype = "market", orderside = "long",
osFUN = "osMaxPos", replace = FALSE, prefer = "Open", TxnFee = -0.0005),
type = "enter", label = "EnterLong")
add.rule(strategy.st, name = "ruleSignal",
arguments = list(sigcol = "bearish_ema_cross", sigval = TRUE,
orderqty = "all", ordertype = "market", orderside = "long",
replace = TRUE, prefer = "Open", TxnFee = -0.0005),
type = "exit", label = "ExitLong")Orders fill at the next bar’s open (prefer = "Open"), not the bar that generated the signal — this is the standard way to keep a backtest free of same-bar look-ahead bias, since in live trading you cannot know a day’s close-based signal until after that day’s market has already closed. A flat 5 basis point slippage/fee (TxnFee = -0.0005) is applied to every fill.
applyStrategy(strategy.st, portfolio.st)
updatePortf(portfolio.st)
updateAcct(account.st)
updateEndEq(account.st)strategy_eq_r1 <- getAccount(account.st)$summary$End.Eq
final_eq <- as.numeric(last(strategy_eq_r1))
total_ret_pct <- (final_eq / init_equity - 1) * 100
strategy_ret_r1 <- dailyReturn(strategy_eq_r1)
ann_ret_pct <- as.numeric(Return.annualized(strategy_ret_r1)) * 100
sharpe <- as.numeric(SharpeRatio.annualized(strategy_ret_r1, Rf = 0))
maxdd_pct <- as.numeric(maxDrawdown(strategy_ret_r1)) * 100
tstats_kpi <- tradeStats(portfolio.st)
n_trades <- sum(tstats_kpi$Num.Trades)
# tradeStats() reports Percent.Positive per symbol, not a raw winner count --
# reconstruct total winners from it (Percent.Positive = winners / trades * 100
# per symbol, so this recovers an integer count exactly).
n_winners <- sum(round(tstats_kpi$Percent.Positive / 100 * tstats_kpi$Num.Trades))
win_rate <- n_winners / n_trades * 100
profit_factor <- sum(tstats_kpi$Gross.Profits) / abs(sum(tstats_kpi$Gross.Losses))| Headline Results | |
| 2023-08-29 to 2026-08-27, fixed 10/30 EMA + RSI>50 | |
| Metric | Value |
|---|---|
| Final Equity | $158,574 |
| Total Return | 58.57% |
| Annualized Return | 16.73% |
| Annualized Sharpe | 1.36 |
| Max Drawdown | 9.81% |
| Closed Trades | 79 |
| Win Rate | 40.5% |
| Profit Factor | 2.50 |
Over the fixed 2023-08-29–2026-08-27 window, the strategy turned $100,000 into $158,574, a total return of 58.57% (16.73% annualized), across 79 closed trades at a 40.5% win rate, with an annualized Sharpe ratio of 1.36 and a maximum drawdown of 9.81%.
tstats <- tradeStats(portfolio.st)| Trade Statistics by Symbol | ||||||
| Symbol | Num.Trades | Percent.Positive | Net.Trading.PL | Avg.Trade.PL | Max.Drawdown | Profit.Factor |
|---|---|---|---|---|---|---|
| XLE | 25 | 20.0 | −3,256 | −199 | −7,331.8 | 0.47 |
| XLF | 12 | 66.7 | 5,268 | 287 | −2,002.2 | 3.39 |
| XLI | 9 | 55.6 | 17,849 | 1,983 | −4,436.5 | 6.07 |
| XLK | 11 | 45.5 | 16,943 | 1,681 | −9,919.2 | 3.47 |
| XLV | 9 | 55.6 | 16,303 | 975 | −4,451.3 | 2.95 |
| XLY | 13 | 30.8 | 5,467 | 454 | −5,997.5 | 1.89 |
This section continues in the same R session, reusing the portfolio, account, and price data already built above.
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")
| Series | Final Equity | Total Return |
|---|---|---|
| Strategy | $158,574 | 58.57% |
| SPY | $177,038 | 77.04% |
| Sector_Basket | $169,438 | 69.44% |
The active strategy is compared against two passive benchmarks: buying and holding SPY, and an equal-weight buy-and-hold basket of all six sector ETFs. Beating a benchmark on raw return alone is a low bar — the risk diagnostics below are what actually distinguish a defensible strategy from one that just got lucky.
# 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))))Average invested exposure (mark-to-market): 93.9%Because every position is a fixed 300-share order rather than a percentage-of-equity allocation, exposure is not capped at 100%: once gains compound, several simultaneously-held winning positions can be worth more than the account’s starting equity, which is exactly what the chart above shows during the strategy’s strongest stretches.
bh_returns <- sapply(symbols, function(s) {
px <- as.numeric(Cl(get(s)))
(px[length(px)] / px[1] - 1) * 100
})| Sector ETF Universe — Buy & Hold, Same Window | |
| Symbol | Buy & Hold Return (%) |
|---|---|
| XLK | 118.43 |
| XLF | 77.12 |
| XLI | 73.98 |
| XLE | 67.48 |
| XLV | 35.25 |
| XLY | 44.35 |
# 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"))| Idle Cash Invested in Short/Intermediate/Long Duration Bond ETFs | |||
| total_return | sharpe | max_dd | |
|---|---|---|---|
| Baseline | 58.57 | 1.36 | 9.81 |
| BIL | 59.49 | 1.39 | 9.08 |
| BND | 56.87 | 1.29 | 10.50 |
| TLT | 47.43 | 0.93 | 14.97 |
Parking idle cash in BIL (near-zero duration T-bills) improves every metric versus leaving it as literal uninvested cash. Longer-duration alternatives (BND, TLT) do not reliably help — over this window, duration risk on the “safe” side of the portfolio can cut against the strategy’s own equity-curve behavior. This is a real, tested result, not a hypothetical estimate.
strategy_ret <- dailyReturn(getAccount(account.st)$summary$End.Eq)
table.DownsideRisk(strategy_ret) daily.returns
Semi Deviation 0.0056
Gain Deviation 0.0052
Loss Deviation 0.0059
Downside Deviation (MAR=210%) 0.0106
Downside Deviation (Rf=0%) 0.0053
Downside Deviation (0%) 0.0053
Maximum Drawdown 0.0981
Historical VaR (95%) -0.0119
Historical ES (95%) -0.0181
Modified VaR (95%) -0.0122
Modified ES (95%) -0.0198table.Drawdowns(strategy_ret, top = 5) From Trough To Depth Length To Trough Recovery
1 2024-12-09 2025-05-06 2025-06-30 -0.0981 138 101 37
2 2024-07-17 2024-08-05 2024-11-06 -0.0894 80 14 66
3 2024-04-01 2024-05-30 2024-07-12 -0.0623 72 43 29
4 2026-07-01 2026-07-20 <NA> -0.0496 41 13 NA
5 2026-06-05 2026-06-10 2026-06-22 -0.0460 11 4 7rolling_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")
The grid search below optimizes over the entire backtest window with full hindsight. It is the right tool for mapping out the parameter surface, but its P&L numbers are not an honest performance estimate — any grid search will always find some combination that fit the historical data best. The walk-forward section that follows is what actually tests whether this strategy design generalizes out-of-sample.
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)This section re-downloads price data through today (2026-09-30) rather than the fixed window used above, so the walk-forward analysis below reflects the most current data available at render time.
# 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), ]| Full-Period Grid Search (hindsight-optimal, not an honest estimate) | ||
| fast_n | slow_n | Net.Trading.PL |
|---|---|---|
| 10 | 20 | 64,462 |
| 10 | 40 | 64,023 |
| 5 | 50 | 62,566 |
| 15 | 30 | 61,781 |
| 15 | 20 | 60,161 |
| 5 | 40 | 59,965 |
| 10 | 30 | 59,038 |
| 20 | 30 | 55,360 |
| 5 | 30 | 54,579 |
| 15 | 40 | 53,971 |
| 20 | 40 | 52,833 |
| 10 | 50 | 52,585 |
| 15 | 50 | 52,510 |
| 5 | 20 | 48,704 |
| 20 | 50 | 47,689 |
Methodology. This walk-forward calls applyStrategy() directly for each parameter combination and window — rather than quantstrat’s built-in apply.paramset()/walk.forward(), which are not reliable across a multi-symbol portfolio. Every training score is computed with updatePortf(Dates = <training window only>), so a position still open at the end of a training window is valued at that day’s price, never a later one — parameter selection never sees data from outside its own training window.
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
}| Walk-Forward Windows (18-month train / 6-month test) | |||
| training.start | training.end | testing.start | testing.end |
|---|---|---|---|
| 2023-08-29 | 2025-01-31 | 2025-02-03 | 2025-07-31 |
| 2024-02-01 | 2025-07-31 | 2025-08-01 | 2026-01-30 |
| 2024-08-01 | 2026-01-30 | 2026-02-02 | 2026-07-31 |
| 2025-02-03 | 2026-07-31 | 2026-08-03 | 2026-09-29 |
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)
}| Parameters Chosen Per Window (from training data only) | |||
| window | fast_n | slow_n | train_pl |
|---|---|---|---|
| 1 | 10 | 20 | 30,208 |
| 2 | 10 | 20 | 20,508 |
| 3 | 15 | 50 | 29,711 |
| 4 | 5 | 50 | 36,823 |
oos_stats <- tradeStats(wf_portfolio.st)| Out-of-Sample Trade Statistics by Symbol | |||||
| Symbol | Num.Trades | Net.Trading.PL | Percent.Positive | Profit.Factor | Max.Drawdown |
|---|---|---|---|---|---|
| XLE | 10 | 972 | 30.0 | 0.95 | −3,405.9 |
| XLF | 8 | −329 | 50.0 | 0.87 | −2,227.6 |
| XLI | 6 | 10,727 | 50.0 | 8.10 | −5,128.1 |
| XLK | 6 | 15,827 | 33.3 | 3.55 | −9,724.8 |
| XLV | 7 | 7,641 | 14.3 | 1.16 | −5,497.3 |
| XLY | 9 | −1,929 | 11.1 | 0.75 | −9,284.3 |
Everything below is measured over the same dates — from the first out-of-sample day to the last — with every series rebased to start at zero, so the comparison is apples-to-apples.
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)| Out-of-Sample Comparison: 2025-02-03 to 2026-09-29 | |||
| Strategy | Total_Return_Pct | Ann_Sharpe | Max_Drawdown_Pct |
|---|---|---|---|
| Walk-forward (out-of-sample) | 32.91 | 1.22 | -8.29 |
| Fixed EMA 10/30 (baseline rule) | 36.86 | 1.40 | -7.81 |
| Hindsight-best fixed 10/40 (unattainable live) | 41.32 | 1.57 | -7.37 |
| SPY buy & hold | 30.35 | 1.01 | -18.76 |
| Equal-weight sector basket | 29.17 | 1.08 | -17.23 |
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))Walk-forward out-of-sample net P&L: $32910 (32.9% vs. SPY 30.4%, sector basket 29.2%) over 2025-02-03 to 2026-09-29d <- 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")
Over 2025-02-03 to 2026-09-29, the walk-forward strategy — re-choosing its EMA parameters every 6 months using only the preceding 18 months of data, with no look-ahead — returned 32.9%, versus 30.4% for SPY buy-and-hold and 36.9% for the simple fixed 10/30 rule from the main backtest held unchanged over the same dates. The walk-forward process is not free — periodically re-optimizing costs something relative to simply picking good parameters once and holding them — but it is the only version of this result that could plausibly have been achieved by someone trading the strategy live, without hindsight.
Only relevant if you’re trying to reproduce this notebook and something doesn’t run the same way.
R version 4.5.0 (2025-04-11 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 26200)
Matrix products: default
LAPACK version 3.12.1
locale:
[1] LC_COLLATE=Spanish_Spain.utf8 LC_CTYPE=Spanish_Spain.utf8
[3] LC_MONETARY=Spanish_Spain.utf8 LC_NUMERIC=C
[5] LC_TIME=Spanish_Spain.utf8
time zone: UTC
tzcode source: internal
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] ggplot2_4.0.3 gt_1.3.0
[3] quantstrat_0.25 foreach_1.5.2
[5] blotter_0.17.0 PerformanceAnalytics_2.0.8
[7] FinancialInstrument_1.3.0 quantmod_0.4.28
[9] TTR_0.24.4 xts_0.14.1
[11] zoo_1.8-14
loaded via a namespace (and not attached):
[1] gtable_0.3.6 jsonlite_2.0.0 dplyr_1.1.4 compiler_4.5.0
[5] tidyselect_1.2.1 xml2_1.3.8 scales_1.4.0 boot_1.3-31
[9] yaml_2.3.10 fastmap_1.2.0 lattice_0.22-6 R6_2.6.1
[13] generics_0.1.4 curl_6.4.0 knitr_1.51 iterators_1.0.14
[17] htmlwidgets_1.6.4 MASS_7.3-65 tibble_3.3.1 RColorBrewer_1.1-3
[21] pillar_1.11.1 rlang_1.1.6 xfun_0.52 S7_0.2.0
[25] sass_0.4.10 fs_1.6.6 quadprog_1.5-8 cli_3.6.5
[29] withr_3.0.2 magrittr_2.0.3 digest_0.6.37 grid_4.5.0
[33] lifecycle_1.0.5 vctrs_0.6.5 evaluate_1.0.3 glue_1.8.0
[37] farver_2.1.2 codetools_0.2-20 rmarkdown_2.31 tools_4.5.0
[41] pkgconfig_2.0.3 htmltools_0.5.8.1 This notebook and its underlying strategy are for research and educational purposes only and do not constitute investment advice. Backtested and historical performance is not a guarantee or reliable indicator of future results. See quantstr.at for the full published article and additional strategy research.