The Black–Litterman Model — the R engine¶

Risk and Asset Allocation¶

The independent R implementation of blacklitterman_python.ipynb. Black–Litterman is pure linear algebra, so we build it from scratch in base R (no packages) and confirm it reproduces the Python results exactly. Self-contained; no prior reading required.

The recipe. Reverse-optimise the market portfolio into an equilibrium prior $\Pi=\delta\Sigma w_{\text{mkt}}$; state views $P\mu=Q+\varepsilon$, $\varepsilon\sim\mathcal N(0,\Omega)$; combine by the Bayesian master formula $$\mu_{\text{BL}}=\big[(\tau\Sigma)^{-1}+P'\Omega^{-1}P\big]^{-1}\big[(\tau\Sigma)^{-1}\Pi+P'\Omega^{-1}Q\big];$$ then optimise $w_{\text{BL}}=\tfrac1\delta\Sigma^{-1}\mu_{\text{BL}}$. With no views $\mu_{\text{BL}}=\Pi$ and $w_{\text{BL}}=w_{\text{mkt}}$: Black–Litterman holds the market and tilts only where views point.

In [1]:
options(repr.plot.width=10, repr.plot.height=4.6)
BLUE<-"#2b6cb0"; ORANGE<-"#dd6b20"; GREEN<-"#2f855a"; RED<-"#c53030"; GREY<-"#718096"

R <- read.csv("sector_etf_weekly.csv", row.names=1)
SECTORS <- setdiff(colnames(R), "SPY"); X <- as.matrix(R[, SECTORS])
Sigma <- cov(X); T <- nrow(X); N <- ncol(X)

# approximate S&P 500 GICS sector cap-weights (2024); market = cap-weighted sector portfolio
capw <- c(XLK=32,XLF=13,XLV=12,XLY=10,XLC=9,XLI=8,XLP=6,XLE=4,XLU=2.5,XLB=2.3)
w_mkt <- capw[SECTORS]; w_mkt <- as.numeric(w_mkt/sum(w_mkt))
mkt_ret <- X %*% w_mkt
delta <- mean(mkt_ret)/var(as.numeric(mkt_ret))
cat(sprintf("delta = %.4f   market weekly mean %.3f%%  vol %.3f%%\n", delta, mean(mkt_ret), sd(mkt_ret)))

delta = 0.0419   market weekly mean 0.312%  vol 2.731%

The real dataset and the market¶

Weekly log-returns (%) of the ten SPDR sector ETFs, Jan 2019 – Dec 2024 (312 weeks): Materials XLB, Energy XLE, Financials XLF, Industrials XLI, Technology XLK, Staples XLP, Utilities XLU, Health-care XLV, Discretionary XLY, Communications XLC. The market is their cap-weighted combination, and the risk-aversion $\delta$ is calibrated from its own realised Sharpe ratio.

In [2]:
# --- Black-Litterman machinery in base R ---
implied   <- function(delta, Sigma, w) as.numeric(delta * (Sigma %*% w))
omega_prop<- function(P, tau, Sigma){ d <- diag(P %*% (tau*Sigma) %*% t(P)); diag(d, nrow=length(d)) }
bl_master <- function(Pi, Sigma, tau, P, Q, Omega){
  itauS <- solve(tau*Sigma); iO <- solve(Omega)
  M <- solve(itauS + t(P) %*% iO %*% P)
  list(mu_bl = as.numeric(M %*% (itauS %*% Pi + t(P) %*% iO %*% Q)), M = M)
}
mvw <- function(mu, Sigma, delta) as.numeric(solve(Sigma, mu)/delta)

Pi <- implied(delta, Sigma, w_mkt)
w_check <- mvw(Pi, Sigma, delta)
cat(sprintf("no-views recovers market? max|w - w_mkt| = %.2e\n", max(abs(w_check - w_mkt))))

ord <- order(Pi)
barplot(Pi[ord]*52, names.arg=SECTORS[ord], horiz=TRUE, las=1, col=BLUE,
        main="Equilibrium implied returns (annualised %)", xlab="% / year")

no-views recovers market? max|w - w_mkt| = 1.35e-15
No description has been provided for this image

1. The naive mean-variance disaster¶

Estimate expected returns by their historical averages and optimise — the trap that motivates Black–Litterman.

In [3]:
mu_hist <- colMeans(X)
w_naive <- mvw(mu_hist, Sigma, delta)
bp <- barplot(rbind(w_naive*100, w_mkt*100), beside=TRUE, names.arg=SECTORS, las=2,
              col=c(RED,GREY), main="Naive MV (historical means) vs market portfolio", ylab="weight (%)")
legend("topleft", c("naive MV","market"), fill=c(RED,GREY), bty="n"); abline(h=0)
cat(sprintf("naive MV: min %.0f%% max %.0f%% gross %.0f%%\n", min(w_naive)*100, max(w_naive)*100, sum(abs(w_naive))*100))
cat(sprintf("market  : min %.0f%% max %.0f%% gross %.0f%%\n", min(w_mkt)*100, max(w_mkt)*100, sum(abs(w_mkt))*100))

naive MV: min -109% max 189% gross 519%

market  : min 2% max 32% gross 100%
No description has been provided for this image

2. Views and the Black–Litterman posterior¶

Two views: Tech beats Staples by 0.60%/wk (relative) and Energy returns 0.20%/wk (absolute). We use $\tau=0.05$ and the He–Litterman $\Omega=\operatorname{diag}(P\,\tau\Sigma\,P')$, then apply the master formula.

In [4]:
tau <- 0.05
P <- matrix(0, 2, N, dimnames=list(NULL, SECTORS))
P[1, "XLK"] <- 1; P[1, "XLP"] <- -1     # Tech - Staples
P[2, "XLE"] <- 1                        # Energy
Q <- c(0.60, 0.20)
Omega <- omega_prop(P, tau, Sigma)
res <- bl_master(Pi, Sigma, tau, P, Q, Omega); mu_bl <- res$mu_bl

cat(sprintf("View 1 (Tech-Staples): view %.2f vs equilibrium %.2f  -> bullish spread\n", 0.60, Pi[which(SECTORS=="XLK")]-Pi[which(SECTORS=="XLP")]))
cat(sprintf("View 2 (Energy):       view %.2f vs equilibrium %.2f  -> bearish energy\n\n", 0.20, Pi[which(SECTORS=="XLE")]))

plot(seq_len(N), Pi[ord]*52, type="b", pch=19, col=GREY, lwd=2, xaxt="n",
     ylim=range(c(Pi,mu_bl))*52, xlab="", ylab="expected return (annualised %)",
     main="Views tilt the equilibrium prior")
lines(seq_len(N), mu_bl[ord]*52, type="b", pch=15, col=BLUE, lwd=2)
axis(1, at=seq_len(N), labels=SECTORS[ord], las=2)
legend("topleft", c("equilibrium prior","Black-Litterman posterior"), col=c(GREY,BLUE), pch=c(19,15), lwd=2, bty="n")

View 1 (Tech-Staples): view 0.60 vs equilibrium 0.19  -> bullish spread

View 2 (Energy):       view 0.20 vs equilibrium 0.35  -> bearish energy
No description has been provided for this image

3. The portfolio: sensible tilts¶

In [5]:
w_bl <- mvw(mu_bl, Sigma, delta); tilt <- w_bl - w_mkt
par(mfrow=c(1,2))
barplot(rbind(w_mkt*100, w_bl*100, w_naive*100), beside=TRUE, names.arg=SECTORS, las=2,
        col=c(GREY,BLUE,RED), main="Portfolios compared", ylab="weight (%)")
legend("topleft", c("market","Black-Litterman","naive MV"), fill=c(GREY,BLUE,RED), bty="n"); abline(h=0)
barplot(tilt*100, names.arg=SECTORS, las=2, col=ifelse(tilt>0,GREEN,RED),
        main="Black-Litterman tilts vs market", ylab="tilt (%)"); abline(h=0)
par(mfrow=c(1,1))
cat(sprintf("gross leverage: market %.0f%%  BL %.0f%%  naive %.0f%%\n",
            sum(abs(w_mkt))*100, sum(abs(w_bl))*100, sum(abs(w_naive))*100))

gross leverage: market 100%  BL 220%  naive 519%
No description has been provided for this image

4. The confidence dial¶

Scaling $\Omega$ by $c$ moves from the market portfolio ($c\to\infty$, vague) to full conviction ($c\to0$, certain).

In [6]:
cs <- c(20, 5, 1, 0.25, 0.05); tracked <- c("XLK","XLP","XLE")
paths <- sapply(cs, function(c){ r <- bl_master(Pi, Sigma, tau, P, Q, c*Omega)
  w <- mvw(r$mu_bl, Sigma, delta); (w - w_mkt)[match(tracked, SECTORS)]*100 })
matplot(seq_along(cs), t(paths), type="b", pch=19, lwd=2, col=c(BLUE,ORANGE,GREEN), xaxt="n",
        xlab="", ylab="tilt vs market (%)", main="From market portfolio to full conviction")
axis(1, at=seq_along(cs), labels=c("vague\n(c=20)","","base","","confident\n(c=0.05)"))
abline(h=0, col=GREY); legend("topleft", tracked, col=c(BLUE,ORANGE,GREEN), pch=19, lwd=2, bty="n")
cat("As confidence rises the tilts on the viewed sectors grow smoothly from zero.\n")

As confidence rises the tilts on the viewed sectors grow smoothly from zero.
No description has been provided for this image

5. Summary¶

  • Base-R Black–Litterman reproduces the Python engine: no views recovers the market, naive MV is unusable, and views produce stable, targeted tilts via the Bayesian master formula.
  • The result is identical across the from-scratch Python, PyMC, and R engines — three routes, one answer.

Project 4 (Robust Bayesian allocation) takes the final step: it stops trusting the single point $(\mu_{\text{BL}},\Sigma)$ and optimises against the whole posterior uncertainty.