# 1. Load data frameworks AND the mathematical solver engines
library(tidyquant)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## ── Attaching core tidyquant packages ─────────────────────── tidyquant 1.0.11 ──
## ✔ PerformanceAnalytics 2.0.8 ✔ TTR 0.24.4
## ✔ quantmod 0.4.28 ✔ xts 0.14.1
## ── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date() masks base::as.Date()
## ✖ zoo::as.Date.numeric() masks base::as.Date.numeric()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary() masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(PortfolioAnalytics)
## Warning: package 'PortfolioAnalytics' was built under R version 4.5.3
## Loading required package: foreach
## Warning: package 'foreach' was built under R version 4.5.3
## Registered S3 method overwritten by 'PortfolioAnalytics':
## method from
## print.constraint ROI
library(tidyr)
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.5.3
##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## ###############################################################################
##
## Attaching package: 'dplyr'
##
## The following objects are masked from 'package:xts':
##
## first, last
##
## The following objects are masked from 'package:stats':
##
## filter, lag
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(lubridate)
##
## Attaching package: 'lubridate'
##
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(xts)
library(ROI) # <--- FORCES SOLVER MANAGER TO LOAD
## Warning: package 'ROI' was built under R version 4.5.3
## ROI: R Optimization Infrastructure
## Registered solver plugins: nlminb, symphony, glpk, quadprog.
## Default solver: auto.
##
## Attaching package: 'ROI'
##
## The following objects are masked from 'package:PortfolioAnalytics':
##
## is.constraint, objective
library(ROI.plugin.quadprog) # <--- ATTACHES THE QUADRATIC OPTIMIZER
## Warning: package 'ROI.plugin.quadprog' was built under R version 4.5.3
library(ROI.plugin.glpk) # <--- ATTACHES THE LINEAR OPTIMIZER
## Warning: package 'ROI.plugin.glpk' was built under R version 4.5.3
# 2. Define the High-Conviction 5 Tickers and Benchmark
tickers <- c('NVDA', 'MSFT', 'LLY', 'AVGO', 'COST')
benchmark_ticker <- 'SPY'
# 3. Download Historical Data (Past 3 Years)
start_date <- Sys.Date() - years(3)
prices <- tq_get(tickers, from = start_date, get = "stock.prices")
# Pivot wide and extract daily returns cleanly
returns_wide <- prices %>%
group_by(symbol) %>%
tq_transmute(select = adjusted, mutate_fun = periodReturn, period = "daily", col_rename = "Ra") %>%
pivot_wider(names_from = symbol, values_from = Ra)
# Convert clean data frame to an integrated time-series matrix
returns_multi <- xts(returns_wide[,-1], order.by = as.Date(returns_wide$date))
returns_multi <- na.omit(returns_multi)
# 4. Formulate Portfolio Specifications & Mathematical Constraints
port_spec <- portfolio.spec(assets = tickers) %>%
add.constraint(type = "full_investment") %>%
add.constraint(type = "long_only") %>%
add.constraint(type = "box", min = 0.0, max = 0.40) %>%
add.objective(type = "return", name = "mean") %>%
add.objective(type = "risk", name = "StdDev")
# 5. Execute Portfolio Optimization (Max Sharpe Ratio via ROI)
opt_weights <- optimize.portfolio(R = returns_multi,
portfolio = port_spec,
optimize_method = "ROI",
maxSR = TRUE) # <--- ALIGNS WITH THE CORRECT FUNCTION ARGUMENT
cat("\n📊 --- AI Optimized Portfolio Weights ---\n")
##
## 📊 --- AI Optimized Portfolio Weights ---
print(extractWeights(opt_weights))
## NVDA MSFT LLY AVGO COST
## 0.1958182 0.0000000 0.2341606 0.1700212 0.4000000
# 6. Backtest Simulation & Return Calculations
portfolio_weights <- extractWeights(opt_weights)
portfolio_returns <- Return.portfolio(returns_multi, weights = portfolio_weights)
colnames(portfolio_returns) <- "High_Conviction_AI_Portfolio"
# Download and parse baseline benchmark returns natively
benchmark_prices <- tq_get(benchmark_ticker, from = start_date, get = "stock.prices")
benchmark_wide <- benchmark_prices %>%
tq_transmute(select = adjusted, mutate_fun = periodReturn, period = "daily", col_rename = "S_P_500_Benchmark")
benchmark_returns <- xts(benchmark_wide$S_P_500_Benchmark, order.by = as.Date(benchmark_wide$date))
colnames(benchmark_returns) <- "S_P_500_Benchmark"
# Combine both time-series arrays
combined_returns <- merge.xts(portfolio_returns, benchmark_returns)
combined_returns <- na.omit(combined_returns)
# 7. Output Final Performance Metrics & Visualizations
cat("\n📈 --- Annualized Performance Summary Matrix ---\n")
##
## 📈 --- Annualized Performance Summary Matrix ---
print(table.AnnualizedReturns(combined_returns))
## High_Conviction_AI_Portfolio S_P_500_Benchmark
## Annualized Return 0.5127 0.2285
## Annualized Std Dev 0.2480 0.1513
## Annualized Sharpe (Rf=0%) 2.0670 1.5098
cat("\n📉 --- Maximum Drawdown & Downside Risk Analysis ---\n")
##
## 📉 --- Maximum Drawdown & Downside Risk Analysis ---
print(table.DownsideRisk(combined_returns))
## High_Conviction_AI_Portfolio S_P_500_Benchmark
## Semi Deviation 0.0112 0.0067
## Gain Deviation 0.0105 0.0070
## Loss Deviation 0.0109 0.0072
## Downside Deviation (MAR=210%) 0.0150 0.0113
## Downside Deviation (Rf=0%) 0.0103 0.0064
## Downside Deviation (0%) 0.0103 0.0064
## Maximum Drawdown 0.2361 0.1876
## Historical VaR (95%) -0.0227 -0.0141
## Historical ES (95%) -0.0348 -0.0210
## Modified VaR (95%) -0.0220 -0.0078
## Modified ES (95%) -0.0331 -0.0078
# 📊 --- NEW: Systematic Risk (CAPM) Metrics ---
cat("\n📊 --- Strategy Alpha & Beta Metrics ---\n")
##
## 📊 --- Strategy Alpha & Beta Metrics ---
portfolio_beta <- CAPM.beta(portfolio_returns, benchmark_returns)
portfolio_alpha <- CAPM.alpha(portfolio_returns, benchmark_returns) * 252 # Annualized
cat("Beta Factor :", round(portfolio_beta, 4), "\n")
## Beta Factor : 1.2469
cat("Alpha (Ann.):", round(portfolio_alpha * 100, 2), "%\n")
## Alpha (Ann.): 17.41 %
# Render performance visualization graphs
charts.PerformanceSummary(combined_returns,
main = "High-Conviction 5-Asset Portfolio vs S&P 500",
colorset = c("#2c3e50", "#e74c3c"))
