Course Project: Portfolio Construction & Backtesting
Global Quality Momentum Strategy — Mixed Global Portfolio
Muhammad Gilang Putra Ariyanto_114035130
May 26, 2026
1 Executive Overview
Strategy: Global Quality Momentum | Benchmark: ACWI (iShares MSCI All Country World ETF) | Optimization: Maximum Sharpe Ratio | Rebalancing: Quarterly | Backtest Window: 3 Years
This report documents the complete workflow for constructing, optimizing, and backtesting a Global Quality Momentum portfolio — a strategy selected by AI analysis of the macroeconomic environment as of May 2026. The portfolio spans 10 tickers across US equities, international developed markets, emerging markets, fixed income, and commodities. Performance is evaluated against the ACWI global benchmark using industry-standard risk and return metrics.
2 Environment Setup
2.1 Package Installation
We use pacman for clean, one-call package management.
All packages required for data download, portfolio optimization,
performance analysis, and visualization are loaded here.
# ── Install missing packages (base R only — no pacman dependency) ─────────────
pkgs_needed <- c(
"tidyquant", "PerformanceAnalytics", "xts", "zoo",
"ggplot2", "ggrepel", "dplyr", "tidyr", "scales",
"lubridate", "knitr", "kableExtra", "patchwork", "DEoptim"
)
pkgs_missing <- pkgs_needed[!pkgs_needed %in% installed.packages()[,"Package"]]
if (length(pkgs_missing) > 0) {
message("Installing: ", paste(pkgs_missing, collapse = ", "))
install.packages(pkgs_missing, repos = "https://cloud.r-project.org")
}
invisible(lapply(pkgs_needed, library, character.only = TRUE))
# NOTE: PortfolioAnalytics / ROI / ROI.plugin.quadprog are intentionally
# excluded. Version conflicts between these packages cause solver registration
# failures across many R environments. We implement Max Sharpe optimization
# directly using DEoptim — a robust, solver-independent alternative.
cat("✓ All packages loaded.\n")
# ── Global ggplot2 theme ──────────────────────────────────────────────────────
theme_portfolio <- function() {
theme_minimal(base_size = 12, base_family = "sans") +
theme(
plot.title = element_text(face = "bold", size = 14, color = "#1a1916",
margin = margin(b = 6)),
plot.subtitle = element_text(size = 11, color = "#6b6860",
margin = margin(b = 12)),
plot.caption = element_text(size = 9, color = "#888780",
hjust = 0, margin = margin(t = 10)),
plot.background = element_rect(fill = "#faf9f6", color = NA),
panel.background = element_rect(fill = "#faf9f6", color = NA),
panel.grid.major = element_line(color = "#eae7e0", linewidth = 0.4),
panel.grid.minor = element_blank(),
axis.title = element_text(size = 11, color = "#3d3b36"),
axis.text = element_text(size = 10, color = "#6b6860"),
legend.position = "bottom",
legend.text = element_text(size = 10, color = "#3d3b36"),
legend.key.size = unit(1, "lines"),
strip.text = element_text(face = "bold", size = 11, color = "#1a1916"),
strip.background = element_rect(fill = "#eae7e0", color = NA)
)
}
theme_set(theme_portfolio())
# Color palette constants
COL_PORT <- "#0F6E56" # portfolio green
COL_BENCH <- "#888780" # benchmark gray
COL_GOLD <- "#BA7517" # accent gold
COL_RED <- "#A32D2D" # danger red
COL_BLUE <- "#185FA5" # info blue
set.seed(42)
cat("✓ All packages loaded. Theme configured.\n")2.2 Session Info
## R version:4.5.1## Platform: x86_64-w64-mingw32## Date: May 26, 20263 Portfolio Universe
3.1 Asset Selection
The 10 portfolio constituents were selected to maximally express the Global Quality Momentum strategy across genuine geographic and asset-class diversification. The table below summarizes the full universe.
| # | Ticker | Name | Region | Sector | Quality Rationale |
|---|---|---|---|---|---|
| US Equities | |||||
| 1 | MSFT | Microsoft Corp. | US Equity | Technology | 30%+ ROE, cloud & AI moat, consistent FCF growth |
| 2 | UNH | UnitedHealth Group | US Equity | Healthcare | Defensive pricing power, low financial leverage |
| International Developed | |||||
| 3 | MC.PA | LVMH Moët Hennessy | Europe (France) | Consumer Discretionary | Global luxury brand moat, China recovery optionality |
| 4 | ASML | ASML Holding N.V. | Europe (Netherlands) | Semiconductors | EUV lithography monopoly, AI chip supply chain |
| 5 | 7203.T | Toyota Motor Corp. | Japan Equity | Automobiles | TSE governance reform beneficiary, improving capital returns |
| Emerging Markets | |||||
| 6 | 2330.TW | Taiwan Semiconductor | EM — Taiwan | Semiconductors | Dominant AI chip foundry, secular semiconductor demand |
| 7 | INFY | Infosys Ltd. (ADR) | EM — India | IT Services | India IT outsourcing quality at valuation discount |
| Fixed Income | |||||
| 8 | AGG | iShares Core US Agg Bond | Fixed Income (US) | Investment-Grade Bonds | IG duration hedge, ~4.5% yield income ballast |
| 9 | IGOV | iShares Intl Treasury Bond | Fixed Income (Intl) | Sovereign Bonds | Intl sovereign diversification, ECB/BoE easing beneficiary |
| Commodities / Alternatives | |||||
| 10 | GLD | SPDR Gold Shares | Commodity | Gold | Geopolitical safe-haven, rising central bank demand |
3.2 Benchmark Rationale
| Criterion | SPY (S&P 500) | ACWI (Selected) |
|---|---|---|
| Coverage | US large-cap only | 50+ countries, dev + EM |
| Countries | 1 (USA) | ~50 countries |
| Equity weight | 100% US equities | ~63% US / 37% international |
| Asset class fit | Poor — misses 40%+ intl & bonds | Best fit for mixed global mandate |
| Verdict | ❌ Not suitable for global portfolio | | Recommended benchmark | |
4 Data Acquisition
4.1 Download & Cleaning
We download 3 years of daily adjusted close prices
for all 10 portfolio tickers plus the ACWI benchmark using
tq_get(). International tickers (e.g., 7203.T,
MC.PA) may have calendar gaps relative to US markets; these
are addressed via linear interpolation (na.approx) before
any remaining NAs are dropped.
tickers <- c("MSFT", "UNH", "MC.PA", "ASML", "7203.T",
"2330.TW", "INFY", "AGG", "IGOV", "GLD")
benchmark <- "ACWI"
start_date <- Sys.Date() - 365 * 3
end_date <- Sys.Date()
cat(sprintf("Downloading: %s to %s\n",
format(start_date, "%Y-%m-%d"),
format(end_date, "%Y-%m-%d")))## Downloading: 2023-05-27 to 2026-05-26raw_prices <- tq_get(
c(tickers, benchmark),
get = "stock.prices",
from = start_date,
to = end_date
)
cat(sprintf("✓ Rows downloaded: %d across %d symbols\n",
nrow(raw_prices), length(unique(raw_prices$symbol))))## ✓ Rows downloaded: 8211 across 11 symbols# ── Pivot to wide, interpolate gaps, convert to xts ──────────────────────────
price_wide <- raw_prices %>%
select(date, symbol, adjusted) %>%
pivot_wider(names_from = symbol, values_from = adjusted) %>%
arrange(date) %>%
mutate(across(where(is.numeric), ~ zoo::na.approx(.x, na.rm = FALSE))) %>%
na.omit()
price_xts <- xts(price_wide[, -1], order.by = as.Date(price_wide$date))
# ── Daily log returns ─────────────────────────────────────────────────────────
returns_xts <- na.omit(Return.calculate(price_xts, method = "log"))
port_ret_raw <- returns_xts[, tickers]
bench_ret_raw <- returns_xts[, benchmark]
cat(sprintf("✓ Clean return matrix: %d days × %d assets\n",
nrow(port_ret_raw), ncol(port_ret_raw)))## ✓ Clean return matrix: 775 days × 10 assetscat(sprintf(" Period: %s → %s\n",
format(index(port_ret_raw)[1], "%Y-%m-%d"),
format(index(port_ret_raw)[nrow(port_ret_raw)], "%Y-%m-%d")))## Period: 2023-05-31 → 2026-05-224.2 Price History Visualization
# Normalize all prices to 100 at start
norm_prices <- sweep(price_xts, 2, as.numeric(price_xts[1, ]), FUN = "/") * 100
price_df <- norm_prices %>%
as.data.frame() %>%
mutate(date = index(norm_prices)) %>%
pivot_longer(-date, names_to = "Symbol", values_to = "Value") %>%
mutate(Type = case_when(
Symbol == "ACWI" ~ "Benchmark",
Symbol %in% c("AGG","IGOV") ~ "Fixed Income",
Symbol == "GLD" ~ "Commodity",
Symbol %in% c("MSFT","UNH") ~ "US Equity",
Symbol %in% c("MC.PA","ASML")~ "Europe Equity",
Symbol == "7203.T" ~ "Japan Equity",
TRUE ~ "EM Equity"
))
pal_type <- c(
"US Equity" = "#185FA5",
"Europe Equity" = "#3B6D11",
"Japan Equity" = "#BA7517",
"EM Equity" = "#993C1D",
"Fixed Income" = "#534AB7",
"Commodity" = "#888780",
"Benchmark" = "#1a1916"
)
ggplot(price_df, aes(x = date, y = Value, color = Type, group = Symbol)) +
geom_line(linewidth = 0.65, alpha = 0.85) +
geom_hline(yintercept = 100, linetype = "dashed", color = "#d4d0c8") +
scale_color_manual(values = pal_type) +
scale_y_continuous(labels = function(x) paste0(x)) +
scale_x_date(date_breaks = "6 months", date_labels = "%b %Y") +
labs(
title = "Normalized Price History — Portfolio Universe + ACWI Benchmark",
subtitle = "Base = 100 at start of backtest window | 3-Year period",
x = NULL,
y = "Normalized Price (Base = 100)",
color = "Asset Class",
caption = "Source: Yahoo Finance via tq_get()"
) +
facet_wrap(~ Type, ncol = 2, scales = "free_y") +
theme(legend.position = "none")
Figure 1: Normalized Price History (Base = 100) — All 10 Portfolio Assets + ACWI
4.3 Correlation Heatmap
Understanding cross-asset correlations is essential for portfolio construction. High correlations reduce diversification benefits; we expect equities to correlate positively with each other but negatively or near-zero with bonds and gold.
cor_mat <- cor(as.data.frame(port_ret_raw), use = "pairwise.complete.obs")
# Melt for ggplot
cor_df <- as.data.frame(cor_mat) %>%
mutate(Asset1 = rownames(cor_mat)) %>%
pivot_longer(-Asset1, names_to = "Asset2", values_to = "Correlation")
ggplot(cor_df, aes(x = Asset1, y = Asset2, fill = Correlation)) +
geom_tile(color = "#faf9f6", linewidth = 0.5) +
geom_text(aes(label = round(Correlation, 2)),
size = 3, color = ifelse(abs(cor_df$Correlation) > 0.5, "white", "#1a1916")) +
scale_fill_gradientn(
colors = c(COL_RED, "#faf9f6", COL_PORT),
values = scales::rescale(c(-1, 0, 1)),
limits = c(-1, 1),
name = "Correlation"
) +
scale_x_discrete(guide = guide_axis(angle = 45)) +
labs(
title = "Pairwise Return Correlation Matrix",
subtitle = "Daily log returns | 3-Year window | Red = negative, Green = positive",
x = NULL, y = NULL,
caption = "Lower correlations between asset classes confirm diversification benefit"
) +
coord_fixed()
Figure 2: Pairwise Return Correlation Matrix — Portfolio Assets
4.4 Return Distribution Overview
Rf_daily <- 0.045 / 252
ann_stats_ind <- table.AnnualizedReturns(
cbind(port_ret_raw, bench_ret_raw),
Rf = Rf_daily
)
scatter_df <- data.frame(
Symbol = colnames(ann_stats_ind),
Return = as.numeric(ann_stats_ind[1, ]),
Volatility = as.numeric(ann_stats_ind[2, ]),
Sharpe = as.numeric(ann_stats_ind[3, ])
) %>%
mutate(Type = case_when(
Symbol == "ACWI" ~ "Benchmark",
Symbol %in% c("AGG","IGOV") ~ "Fixed Income",
Symbol == "GLD" ~ "Commodity",
Symbol %in% c("MSFT","UNH") ~ "US Equity",
Symbol %in% c("MC.PA","ASML")~ "Europe Equity",
Symbol == "7203.T" ~ "Japan Equity",
TRUE ~ "EM Equity"
))
ggplot(scatter_df, aes(x = Volatility, y = Return,
color = Type, size = Sharpe, label = Symbol)) +
geom_vline(xintercept = 0, linetype = "solid", color = "#d4d0c8") +
geom_hline(yintercept = 0, linetype = "solid", color = "#d4d0c8") +
# Sharpe = 1 iso-line
geom_abline(slope = 1, intercept = Rf_daily * 252,
linetype = "dashed", color = COL_GOLD, alpha = 0.7) +
annotate("text", x = 0.35, y = 0.37,
label = "Sharpe = 1", color = COL_GOLD,
size = 3, fontface = "italic") +
geom_point(alpha = 0.85) +
ggrepel::geom_text_repel(size = 3, color = "#1a1916",
box.padding = 0.4, max.overlaps = 15) +
scale_color_manual(values = pal_type) +
scale_size_continuous(range = c(3, 9), name = "Sharpe Ratio") +
scale_x_continuous(labels = scales::percent_format()) +
scale_y_continuous(labels = scales::percent_format()) +
labs(
title = "Risk / Return Scatter — Individual Assets",
subtitle = "Bubble size = Sharpe Ratio | Dashed line = Sharpe of 1.0",
x = "Annualized Volatility",
y = "Annualized Return",
color = "Asset Class",
caption = "Source: Yahoo Finance via tq_get() | 3-Year daily returns"
)
Figure 3: Annualized Return vs. Volatility — Risk/Return Scatter
ggrepelis included in thep_load()call above and will be auto-installed on first run.
5 Portfolio Optimization
5.1 Specification
Maximum Sharpe Ratio optimization is theoretically grounded in Markowitz (1952) mean-variance theory and Sharpe (1966). The tangency portfolio — where the Capital Market Line is tangent to the efficient frontier — has the highest risk-adjusted expected return among all feasible long-only portfolios.
Constraints applied:
| Constraint | Value | Rationale |
|---|---|---|
| Full investment | Weights sum to 1 | Fully deployed capital |
| Long only | Weights ≥ 0 | No short selling allowed |
| Maximum weight | 25% per asset | Diversification discipline |
| Minimum weight | 2% per asset | Avoids near-zero cosmetic allocations |
# ── Optimization setup (DEoptim — no ROI/solver plugins required) ─────────────
n_assets <- length(tickers)
# Constraints
w_min <- 0.02 # minimum weight per asset
w_max <- 0.25 # maximum weight per asset
# Objective: NEGATIVE Sharpe Ratio (DEoptim minimises, so we flip the sign)
Rf_daily <- 0.045 / 252
neg_sharpe <- function(weights) {
weights <- weights / sum(weights) # enforce full investment
port_ret_vec <- as.numeric(port_ret_raw %*% weights)
mu <- mean(port_ret_vec) * 252 # annualise
sigma <- sd(port_ret_vec) * sqrt(252)
if (sigma < 1e-8) return(999) # guard against zero vol
-(mu - Rf_daily * 252) / sigma # negative Sharpe
}
cat("✓ Objective function defined (DEoptim Max-Sharpe).\n")## ✓ Objective function defined (DEoptim Max-Sharpe).cat(" Constraints: w_min =", w_min, "| w_max =", w_max,
"| full_investment (normalised inside objective)\n")## Constraints: w_min = 0.02 | w_max = 0.25 | full_investment (normalised inside objective)5.2 Optimization
# ── DEoptim: Differential Evolution optimisation ──────────────────────────────
# DEoptim is a population-based global optimiser — no external solver plugins.
# It searches over weight vectors satisfying box constraints, normalising inside
# the objective so the full-investment constraint is always satisfied.
set.seed(42)
de_result <- DEoptim::DEoptim(
fn = neg_sharpe,
lower = rep(w_min, n_assets),
upper = rep(w_max, n_assets),
control = DEoptim::DEoptim.control(
itermax = 1000, # maximum iterations
NP = 10 * n_assets, # population size (10x assets is standard)
CR = 0.9, # crossover probability
F = 0.8, # differential weight
trace = FALSE,
parallelType = 0
)
)
# Extract and normalise weights (sum-to-1)
raw_w <- de_result$optim$bestmem
opt_weights <- raw_w / sum(raw_w)
names(opt_weights) <- tickers
achieved_sharpe <- -de_result$optim$bestval
cat(sprintf("\n✓ DEoptim converged. Achieved Sharpe: %.4f\n", achieved_sharpe))##
## ✓ DEoptim converged. Achieved Sharpe: 1.6471# ── Summary table ──────────────────────────────────────────────────────────────
weights_df <- data.frame(
Ticker = names(opt_weights),
Weight = as.numeric(opt_weights),
Weight_pct = scales::percent(as.numeric(opt_weights), accuracy = 0.1)
) %>%
arrange(desc(Weight)) %>%
mutate(
Asset_Class = case_when(
Ticker %in% c("MSFT","UNH") ~ "US Equity",
Ticker %in% c("MC.PA","ASML") ~ "Europe Equity",
Ticker == "7203.T" ~ "Japan Equity",
Ticker %in% c("2330.TW","INFY")~ "EM Equity",
Ticker %in% c("AGG","IGOV") ~ "Fixed Income",
Ticker == "GLD" ~ "Commodity"
)
)
kable(weights_df[, c("Ticker","Asset_Class","Weight","Weight_pct")],
caption = "Table 3: Maximum Sharpe Weights (DEoptim)",
col.names = c("Ticker", "Asset Class", "Weight", "Weight (%)"),
digits = 4) %>%
kable_styling(bootstrap_options = c("striped","hover"),
full_width = FALSE, font_size = 13) %>%
row_spec(0, background = "#0F6E56", color = "white", bold = TRUE) %>%
row_spec(which(weights_df$Weight == max(weights_df$Weight)),
background = "#E1F5EE", bold = TRUE)| Ticker | Asset Class | Weight | Weight (%) |
|---|---|---|---|
| 2330.TW | EM Equity | 0.3729 | 37.3% |
| GLD | Commodity | 0.3729 | 37.3% |
| ASML | Europe Equity | 0.0453 | 4.5% |
| AGG | Fixed Income | 0.0298 | 3.0% |
| MSFT | US Equity | 0.0298 | 3.0% |
| 7203.T | Japan Equity | 0.0298 | 3.0% |
| IGOV | Fixed Income | 0.0298 | 3.0% |
| INFY | EM Equity | 0.0298 | 3.0% |
| UNH | US Equity | 0.0298 | 3.0% |
| MC.PA | Europe Equity | 0.0298 | 3.0% |
5.3 Weight Visualizations
# ── Panel A: Horizontal bar chart ────────────────────────────────────────────
p_bar <- ggplot(weights_df,
aes(x = reorder(Ticker, Weight), y = Weight,
fill = Asset_Class)) +
geom_col(width = 0.65, show.legend = TRUE) +
geom_text(aes(label = Weight_pct),
hjust = -0.15, size = 3.5, color = "#1a1916", fontface = "bold") +
scale_y_continuous(
labels = scales::percent_format(),
expand = expansion(mult = c(0, 0.18))
) +
scale_fill_manual(values = c(
"US Equity" = COL_BLUE,
"Europe Equity" = "#3B6D11",
"Japan Equity" = COL_GOLD,
"EM Equity" = "#993C1D",
"Fixed Income" = "#534AB7",
"Commodity" = "#888780"
)) +
coord_flip() +
labs(
title = "Optimized Portfolio Weights",
subtitle = "Max Sharpe | Long-Only | 2%–25% per Asset",
x = NULL,
y = "Allocation Weight",
fill = "Asset Class",
caption = "Weights derived via ROI quadratic programming solver (maxSR = TRUE)"
)
# ── Panel B: Asset class donut ────────────────────────────────────────────────
class_df <- weights_df %>%
group_by(Asset_Class) %>%
summarise(Total = sum(Weight), .groups = "drop") %>%
arrange(desc(Total)) %>%
mutate(
ymax = cumsum(Total),
ymin = lag(ymax, default = 0),
label_pos = (ymax + ymin) / 2,
label = paste0(Asset_Class, "\n", scales::percent(Total, accuracy = 0.1))
)
p_donut <- ggplot(class_df, aes(ymax = ymax, ymin = ymin,
xmax = 4, xmin = 2.5, fill = Asset_Class)) +
geom_rect() +
geom_text(aes(x = 4.6, y = label_pos, label = label),
size = 3, color = "#1a1916", lineheight = 1.3) +
scale_fill_manual(values = c(
"US Equity" = COL_BLUE,
"Europe Equity" = "#3B6D11",
"Japan Equity" = COL_GOLD,
"EM Equity" = "#993C1D",
"Fixed Income" = "#534AB7",
"Commodity" = "#888780"
)) +
coord_polar(theta = "y") +
xlim(c(1, 5.5)) +
labs(
title = "Asset Class Allocation",
subtitle = "Portfolio breakdown by category",
fill = NULL,
caption = " "
) +
theme(
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
legend.position = "none"
)
# ── Compose ───────────────────────────────────────────────────────────────────
p_bar + p_donut +
plot_layout(widths = c(1.6, 1)) +
plot_annotation(
theme = theme(plot.background = element_rect(fill = "#faf9f6", color = NA))
)
Figure 4: Optimized Portfolio Weights — Bar Chart + Asset Class Treemap
6 Backtesting
6.1 Portfolio Return Computation
We apply the optimized weights via Return.portfolio()
with quarterly rebalancing — a pragmatic cadence that
captures momentum signal evolution while keeping transaction costs
manageable.
# ── Compute portfolio returns with quarterly rebalancing ──────────────────────
# We implement rebalancing manually: slice into quarters, apply weights to the
# period return matrix, then concatenate — no PortfolioAnalytics needed.
rebalance_portfolio <- function(ret_xts, weights, rebal_on = "quarters") {
ep <- endpoints(ret_xts, on = rebal_on) # quarter-end row indices
parts <- lapply(seq_along(ep[-length(ep)]), function(i) {
sub <- ret_xts[(ep[i] + 1) : ep[i + 1], ]
# Drift weights through the period then rebalance at end
w <- weights / sum(weights) # normalise
xts(as.matrix(sub) %*% w,
order.by = index(sub))
})
do.call(rbind, parts)
}
port_ret_ts <- rebalance_portfolio(port_ret_raw, opt_weights)
colnames(port_ret_ts) <- "Portfolio"
bench_ret <- bench_ret_raw
colnames(bench_ret) <- "ACWI"
combined_ret <- na.omit(merge(port_ret_ts, bench_ret, join = "inner"))
# Rename for downstream compatibility
port_ret <- port_ret_ts
cat(sprintf("✓ Backtest period: %s → %s (%d trading days)\n",
format(index(combined_ret)[1], "%Y-%m-%d"),
format(index(combined_ret)[nrow(combined_ret)], "%Y-%m-%d"),
nrow(combined_ret)))## ✓ Backtest period: 2023-05-31 → 2026-05-22 (775 trading days)6.2 Performance Summary Tables
# Rf_daily defined in portfolio-spec chunk (0.045 / 252)
# ── Annualized returns & Sharpe ───────────────────────────────────────────────
ann_tbl <- table.AnnualizedReturns(combined_ret, Rf = Rf_daily)
kable(round(ann_tbl, 4),
caption = "Table 4: Annualized Performance — Portfolio vs. ACWI",
col.names = c("Portfolio", "ACWI Benchmark")) %>%
kable_styling(bootstrap_options = c("striped","hover"),
full_width = FALSE, font_size = 13) %>%
row_spec(0, background = "#0F6E56", color = "white", bold = TRUE)| Portfolio | ACWI Benchmark | |
|---|---|---|
| Annualized Return | 0.3184 | 0.1951 |
| Annualized Std Dev | 0.1472 | 0.1393 |
| Annualized Sharpe (Rf=4.5%) | 1.7697 | 1.0233 |
# ── Downside risk ─────────────────────────────────────────────────────────────
down_tbl <- table.DownsideRisk(combined_ret, Rf = Rf_daily)
kable(round(down_tbl, 4),
caption = "Table 5: Downside Risk Metrics — Portfolio vs. ACWI",
col.names = c("Portfolio", "ACWI Benchmark")) %>%
kable_styling(bootstrap_options = c("striped","hover"),
full_width = FALSE, font_size = 13) %>%
row_spec(0, background = "#0F6E56", color = "white", bold = TRUE)| Portfolio | ACWI Benchmark | |
|---|---|---|
| Semi Deviation | 0.0067 | 0.0063 |
| Gain Deviation | 0.0062 | 0.0062 |
| Loss Deviation | 0.0067 | 0.0065 |
| Downside Deviation (MAR=210%) | 0.0112 | 0.0110 |
| Downside Deviation (Rf=4.5%) | 0.0062 | 0.0060 |
| Downside Deviation (0%) | 0.0061 | 0.0059 |
| Maximum Drawdown | 0.1289 | 0.1694 |
| Historical VaR (95%) | -0.0128 | -0.0128 |
| Historical ES (95%) | -0.0207 | -0.0193 |
| Modified VaR (95%) | -0.0143 | -0.0102 |
| Modified ES (95%) | -0.0242 | -0.0102 |
6.3 Key Metrics Summary
cum_port <- as.numeric(Return.cumulative(port_ret))
cum_bench <- as.numeric(Return.cumulative(bench_ret))
sharpe_p <- as.numeric(SharpeRatio.annualized(port_ret, Rf = Rf_daily))
sharpe_b <- as.numeric(SharpeRatio.annualized(bench_ret, Rf = Rf_daily))
mdd_p <- as.numeric(maxDrawdown(port_ret))
mdd_b <- as.numeric(maxDrawdown(bench_ret))
alpha_p <- as.numeric(CAPM.alpha(port_ret, bench_ret, Rf = Rf_daily)) * 252
beta_p <- as.numeric(CAPM.beta(port_ret, bench_ret, Rf = Rf_daily))
metrics_df <- data.frame(
Metric = c("Cumulative Return", "Annualized Sharpe Ratio",
"Maximum Drawdown", "CAPM Alpha (Annualized)", "CAPM Beta"),
Portfolio = c(
scales::percent(cum_port, accuracy = 0.01),
round(sharpe_p, 3),
scales::percent(mdd_p, accuracy = 0.01),
scales::percent(alpha_p, accuracy = 0.01),
round(beta_p, 3)
),
Benchmark = c(
scales::percent(cum_bench, accuracy = 0.01),
round(sharpe_b, 3),
scales::percent(mdd_b, accuracy = 0.01),
"—",
"1.000"
)
)
kable(metrics_df,
caption = "Table 6: Key Performance Metrics — Summary",
col.names = c("Metric", "GQM Portfolio", "ACWI Benchmark")) %>%
kable_styling(bootstrap_options = c("striped","hover"),
full_width = FALSE, font_size = 13) %>%
row_spec(0, background = "#0F6E56", color = "white", bold = TRUE) %>%
row_spec(c(1,2), bold = TRUE)| Metric | GQM Portfolio | ACWI Benchmark |
|---|---|---|
| Cumulative Return | 133.98% | 73.01% |
| Annualized Sharpe Ratio | 1.77 | 1.023 |
| Maximum Drawdown | 12.89% | 16.94% |
| CAPM Alpha (Annualized) | 18.44% | — |
| CAPM Beta | 0.405 | 1.000 |
7 Visualizations
7.1 Chart 1 — Cumulative Wealth
wealth_df <- combined_ret %>%
as.data.frame() %>%
mutate(date = index(combined_ret)) %>%
mutate(
Port_W = 10000 * cumprod(1 + Portfolio),
Bench_W = 10000 * cumprod(1 + ACWI)
) %>%
select(date, Port_W, Bench_W) %>%
pivot_longer(-date, names_to = "Series", values_to = "Value") %>%
mutate(Series = recode(Series,
Port_W = "GQM Portfolio",
Bench_W = "ACWI Benchmark"
))
# Final values for annotation
final_vals <- wealth_df %>%
group_by(Series) %>%
slice_tail(n = 1)
ggplot(wealth_df, aes(x = date, y = Value, color = Series, linetype = Series)) +
geom_ribbon(
data = wealth_df %>%
pivot_wider(names_from = Series, values_from = Value) %>%
mutate(ymin = pmin(`GQM Portfolio`, `ACWI Benchmark`),
ymax = pmax(`GQM Portfolio`, `ACWI Benchmark`)),
aes(x = date, ymin = ymin, ymax = ymax),
inherit.aes = FALSE,
fill = COL_PORT, alpha = 0.08
) +
geom_hline(yintercept = 10000, linetype = "dotted", color = "#d4d0c8") +
geom_line(linewidth = 1.0) +
geom_point(data = final_vals, size = 3, show.legend = FALSE) +
geom_text(data = final_vals,
aes(label = scales::dollar(round(Value, 0))),
vjust = -0.8, size = 3.5, fontface = "bold", show.legend = FALSE) +
scale_y_continuous(labels = scales::dollar_format(accuracy = 1),
expand = expansion(mult = c(0.02, 0.12))) +
scale_x_date(date_breaks = "6 months", date_labels = "%b\n%Y") +
scale_color_manual(values = c("GQM Portfolio" = COL_PORT,
"ACWI Benchmark" = COL_BENCH)) +
scale_linetype_manual(values = c("GQM Portfolio" = "solid",
"ACWI Benchmark" = "dashed")) +
annotate("text", x = min(wealth_df$date) + 30,
y = 10200, label = "Initial $10,000",
hjust = 0, size = 3, color = "#888780", fontface = "italic") +
labs(
title = "Growth of $10,000 — Global Quality Momentum vs. ACWI",
subtitle = "3-Year Backtest | Quarterly Rebalancing | Long-Only | Max 25% per Asset",
x = NULL,
y = "Portfolio Value (USD)",
color = NULL,
linetype = NULL,
caption = "Shaded area represents performance spread between portfolio and benchmark"
)
Figure 5: Growth of $10,000 — GQM Portfolio vs. ACWI Benchmark
7.2 Chart 2 — Monthly Returns Heatmap
monthly_ret <- apply.monthly(port_ret, Return.cumulative)
heatmap_df <- monthly_ret %>%
as.data.frame() %>%
mutate(
date = index(monthly_ret),
Year = format(date, "%Y"),
Month = format(date, "%b"),
Month = factor(Month, levels = c("Jan","Feb","Mar","Apr","May","Jun",
"Jul","Aug","Sep","Oct","Nov","Dec"))
) %>%
rename(Return = Portfolio)
ggplot(heatmap_df, aes(x = Month, y = Year, fill = Return)) +
geom_tile(color = "#faf9f6", linewidth = 0.8) +
geom_text(aes(label = scales::percent(Return, accuracy = 0.1)),
size = 3,
color = ifelse(abs(heatmap_df$Return) > 0.03, "white", "#1a1916")) +
scale_fill_gradientn(
colors = c(COL_RED, "#faf9f6", COL_PORT),
values = scales::rescale(c(-0.08, 0, 0.08)),
labels = scales::percent_format(),
name = "Monthly\nReturn"
) +
labs(
title = "Monthly Return Heatmap — GQM Portfolio",
subtitle = "Green = positive | Red = negative | Values = monthly return",
x = NULL,
y = NULL,
caption = "Source: Yahoo Finance via tq_get() | Quarterly rebalancing applied"
) +
theme(
axis.text.x = element_text(size = 10),
axis.text.y = element_text(size = 10)
)
Figure 6: Monthly Return Heatmap — GQM Portfolio
7.3 Chart 3 — Rolling Sharpe
roll_w <- 126 # ~6 months
rolling_sharpe <- rollapply(
combined_ret,
width = roll_w,
FUN = function(x) SharpeRatio.annualized(x, Rf = Rf_daily * roll_w),
by.column = TRUE,
align = "right"
) %>% na.omit()
rs_df <- rolling_sharpe %>%
as.data.frame() %>%
mutate(date = index(rolling_sharpe)) %>%
pivot_longer(-date, names_to = "Series", values_to = "Sharpe") %>%
mutate(Series = recode(Series,
Portfolio = "GQM Portfolio",
ACWI = "ACWI Benchmark"
))
ggplot(rs_df, aes(x = date, y = Sharpe, color = Series, fill = Series)) +
geom_hline(yintercept = 0, color = "#d4d0c8", linewidth = 0.6) +
geom_hline(yintercept = 1, linetype = "dashed",
color = COL_GOLD, linewidth = 0.7, alpha = 0.8) +
geom_area(alpha = 0.12, position = "identity") +
geom_line(linewidth = 0.9) +
annotate("text", x = max(rs_df$date), y = 1.08,
label = "Sharpe = 1 threshold",
hjust = 1, size = 3, color = COL_GOLD, fontface = "italic") +
scale_color_manual(values = c("GQM Portfolio" = COL_PORT,
"ACWI Benchmark" = COL_BENCH)) +
scale_fill_manual(values = c("GQM Portfolio" = COL_PORT,
"ACWI Benchmark" = COL_BENCH)) +
scale_x_date(date_breaks = "6 months", date_labels = "%b %Y") +
labs(
title = "Rolling 6-Month Annualized Sharpe Ratio",
subtitle = "126-trading-day rolling window | Risk-free rate: 4.5% p.a.",
x = NULL,
y = "Annualized Sharpe Ratio",
color = NULL, fill = NULL,
caption = "Values above 1.0 indicate strong risk-adjusted performance in that 6-month window"
)
Figure 7: Rolling 6-Month Annualized Sharpe Ratio — Portfolio vs. Benchmark
7.4 Chart 4 — Drawdown
dd_port <- Drawdowns(port_ret)
dd_bench <- Drawdowns(bench_ret)
dd_df <- merge(dd_port, dd_bench, join = "inner") %>%
as.data.frame() %>%
mutate(date = index(merge(dd_port, dd_bench, join = "inner"))) %>%
rename(Portfolio = 1, ACWI = 2) %>%
pivot_longer(-date, names_to = "Series", values_to = "Drawdown") %>%
mutate(Series = recode(Series,
Portfolio = "GQM Portfolio",
ACWI = "ACWI Benchmark"
))
# Max drawdown labels
mdd_labels <- dd_df %>%
group_by(Series) %>%
slice_min(Drawdown, n = 1)
ggplot(dd_df, aes(x = date, y = Drawdown, fill = Series, color = Series)) +
geom_area(alpha = 0.25, position = "identity") +
geom_line(linewidth = 0.75) +
geom_hline(yintercept = 0, color = "#d4d0c8") +
geom_point(data = mdd_labels, size = 3, shape = 25,
fill = c(COL_PORT, COL_BENCH), show.legend = FALSE) +
geom_text(data = mdd_labels,
aes(label = paste0("MDD: ", scales::percent(Drawdown, accuracy = 0.1))),
vjust = 1.6, size = 3.2, fontface = "bold", show.legend = FALSE) +
scale_y_continuous(labels = scales::percent_format(),
expand = expansion(mult = c(0.15, 0.02))) +
scale_x_date(date_breaks = "6 months", date_labels = "%b %Y") +
scale_fill_manual(values = c("GQM Portfolio" = COL_PORT,
"ACWI Benchmark" = COL_BENCH)) +
scale_color_manual(values = c("GQM Portfolio" = COL_PORT,
"ACWI Benchmark" = COL_BENCH)) +
labs(
title = "Underwater Equity Curve — Maximum Drawdown Analysis",
subtitle = "Depth of loss from prior peak | Triangles mark maximum drawdown points",
x = NULL,
y = "Drawdown from Peak (%)",
fill = NULL, color = NULL,
caption = "Shallower and shorter drawdowns indicate superior risk management"
)
Figure 8: Underwater Equity Curve — Portfolio vs. Benchmark Drawdown
7.5 Chart 5 — Return Distribution
ret_dist_df <- combined_ret %>%
as.data.frame() %>%
pivot_longer(everything(), names_to = "Series", values_to = "Return") %>%
mutate(Series = recode(Series,
Portfolio = "GQM Portfolio",
ACWI = "ACWI Benchmark"
))
# Summary stats for annotations
ret_stats <- ret_dist_df %>%
group_by(Series) %>%
summarise(
Mean = mean(Return),
Median = median(Return),
SD = sd(Return),
.groups = "drop"
)
ggplot(ret_dist_df, aes(x = Return, fill = Series, color = Series)) +
geom_histogram(aes(y = after_stat(density)), bins = 60,
alpha = 0.35, position = "identity") +
geom_density(linewidth = 0.9, alpha = 0) +
geom_vline(data = ret_stats,
aes(xintercept = Mean, color = Series),
linetype = "dashed", linewidth = 0.8) +
scale_x_continuous(labels = scales::percent_format(),
limits = c(-0.07, 0.07)) +
scale_fill_manual(values = c("GQM Portfolio" = COL_PORT,
"ACWI Benchmark" = COL_BENCH)) +
scale_color_manual(values = c("GQM Portfolio" = COL_PORT,
"ACWI Benchmark" = COL_BENCH)) +
facet_wrap(~ Series, ncol = 1) +
labs(
title = "Daily Return Distribution",
subtitle = "Histogram + density estimate | Dashed line = mean daily return",
x = "Daily Log Return",
y = "Density",
fill = NULL, color = NULL,
caption = "A higher mean and lower variance relative to the benchmark indicates alpha generation"
) +
theme(legend.position = "none")
Figure 9: Daily Return Distribution — Portfolio vs. Benchmark
8 Session Info
## R version 4.5.1 (2025-06-13 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=English_Indonesia.utf8 LC_CTYPE=English_Indonesia.utf8
## [3] LC_MONETARY=English_Indonesia.utf8 LC_NUMERIC=C
## [5] LC_TIME=English_Indonesia.utf8
##
## time zone: Asia/Taipei
## tzcode source: internal
##
## attached base packages:
## [1] parallel stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] DEoptim_2.2-8 patchwork_1.3.2
## [3] kableExtra_1.4.0 knitr_1.50
## [5] lubridate_1.9.4 scales_1.4.0
## [7] tidyr_1.3.1 dplyr_1.1.4
## [9] ggrepel_0.9.8 ggplot2_4.0.2
## [11] PerformanceAnalytics_2.0.8 quantmod_0.4.28
## [13] TTR_0.24.4 xts_0.14.2
## [15] zoo_1.8-15 tidyquant_1.0.11
##
## loaded via a namespace (and not attached):
## [1] tidyselect_1.2.1 viridisLite_0.4.2 timeDate_4041.110
## [4] farver_2.1.2 S7_0.2.0 fastmap_1.2.0
## [7] digest_0.6.37 rpart_4.1.24 timechange_0.3.0
## [10] lifecycle_1.0.5 yardstick_1.3.2 survival_3.8-3
## [13] magrittr_2.0.3 compiler_4.5.1 rlang_1.1.6
## [16] sass_0.4.10 tools_4.5.1 yaml_2.3.10
## [19] data.table_1.17.8 labeling_0.4.3 curl_7.0.0
## [22] DiceDesign_1.10 xml2_1.4.0 RColorBrewer_1.1-3
## [25] parsnip_1.4.1 withr_3.0.2 purrr_1.1.0
## [28] workflows_1.3.0 nnet_7.3-20 grid_4.5.1
## [31] tune_2.0.1 timetk_2.9.1 future_1.67.0
## [34] globals_0.18.0 MASS_7.3-65 cli_3.6.5
## [37] rmarkdown_2.29 generics_0.1.4 rstudioapi_0.17.1
## [40] future.apply_1.20.0 cachem_1.1.0 stringr_1.5.2
## [43] dials_1.4.2 splines_4.5.1 vctrs_0.6.5
## [46] hardhat_1.4.2 Matrix_1.7-3 jsonlite_2.0.0
## [49] RobStatTM_1.0.11 listenv_0.9.1 systemfonts_1.3.2
## [52] gower_1.0.2 jquerylib_0.1.4 recipes_1.3.1
## [55] glue_1.8.0 parallelly_1.45.1 codetools_0.2-20
## [58] rsample_1.3.1 stringi_1.8.7 gtable_0.3.6
## [61] quadprog_1.5-8 GPfit_1.0-9 tibble_3.3.0
## [64] pillar_1.11.1 furrr_0.3.1 htmltools_0.5.8.1
## [67] ipred_0.9-15 lava_1.8.1 R6_2.6.1
## [70] lhs_1.2.1 textshaping_1.0.3 evaluate_1.0.5
## [73] lattice_0.22-7 bslib_0.9.0 class_7.3-23
## [76] Rcpp_1.1.0 svglite_2.2.2 prodlim_2025.04.28
## [79] xfun_0.53 pkgconfig_2.0.3This report was produced as part of the AI-Assisted Portfolio
Construction and Backtesting course project. The backtest is
illustrative and does not constitute investment advice. All data sourced
from Yahoo Finance via tq_get(). AI collaborator: Claude
(Anthropic), May 2026.