library(tidyquant)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
## ── Attaching core tidyquant packages ─────────────────────── tidyquant 1.0.12 ──
## ✔ PerformanceAnalytics 2.1.0      ✔ TTR                  0.24.4
## ✔ quantmod             0.4.28     ✔ xts                  0.14.2
## ── 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(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.1     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.3     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first()  masks xts::first()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ dplyr::last()   masks xts::last()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(PortfolioAnalytics)
## Loading required package: foreach
## 
## Attaching package: 'foreach'
## 
## The following objects are masked from 'package:purrr':
## 
##     accumulate, when
## 
## Registered S3 method overwritten by 'PortfolioAnalytics':
##   method           from
##   print.constraint ROI
library(PerformanceAnalytics)
library(ROI)
## 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)
library(ROI.plugin.glpk)
library(xts)
library(lubridate)

Define tickers and benchmark

tickers <- c(
  "VFLO",
  "QUAL",
  "MTUM",
  "SPHQ",
  "PDP",
  "COWZ",
  "JQUA",
  "QMOM",
  "PRF",
  "VIG"
)

benchmark <- "SPY"

Download asset historical data

start_date <- Sys.Date() - years(3)

prices <- tq_get(
  tickers,
  from = start_date,
  get = "stock.prices"
)

benchmark_prices <- tq_get(
  benchmark,
  from = start_date,
  get = "stock.prices"
)

Calculate Daily returns

returns_data <- prices %>%
  group_by(symbol) %>%
  tq_transmute(
    select = adjusted,
    mutate_fun = periodReturn,
    period = "daily",
    col_rename = "returns"
  )

returns_wide <- returns_data %>%
  select(date, symbol, returns) %>%
  pivot_wider(
    names_from = symbol,
    values_from = returns
  )

returns_xts <- xts(
  returns_wide[, -1],
  order.by = returns_wide$date
)

Benchmark Returns

benchmark_returns_df <- benchmark_prices %>%
  tq_transmute(
    select = adjusted,
    mutate_fun = periodReturn,
    period = "daily",
    col_rename = "SPY"
  )

benchmark_returns <- xts(
  benchmark_returns_df[, -1],
  order.by = benchmark_returns_df$date
)

5. Portfolio Optimization

Maximum Sharpe Ratio

portfolio_spec <- portfolio.spec(assets = tickers) %>%
  
  add.constraint(type = "full_investment") %>%
  
  add.constraint(type = "long_only") %>%
  
  add.constraint(
    type = "box",
    min = 0,
    max = 0.20
  ) %>%
  
  add.objective(
    type = "return",
    name = "mean"
  ) %>%
  
  add.objective(
    type = "risk",
    name = "StdDev"
  )

optimized_portfolio <- optimize.portfolio(
  R = returns_xts,
  portfolio = portfolio_spec,
  optimize_method = "ROI",
  max_sharpe = TRUE
)

Extract optimized weights

optimal_weights <- extractWeights(optimized_portfolio)

# Display weights

optimal_weights
##         VFLO         QUAL         MTUM         SPHQ          PDP         COWZ 
## 2.000000e-01 0.000000e+00 2.000000e-01 2.000000e-01 2.000000e-01 1.277634e-17 
##         JQUA         QMOM          PRF          VIG 
## 5.416154e-31 3.219647e-15 2.000000e-01 7.457830e-17
# Clean very small weights
optimal_weights[abs(optimal_weights) < 0.0001] <- 0

# Round for readability
round(optimal_weights, 4)
## VFLO QUAL MTUM SPHQ  PDP COWZ JQUA QMOM  PRF  VIG 
##  0.2  0.0  0.2  0.2  0.2  0.0  0.0  0.0  0.2  0.0

6. Backtesting Portfolio

portfolio_returns <- Return.portfolio(
  R = returns_xts,
  weights = optimal_weights,
  rebalance_on = "months"
)
## Warning in Return.portfolio(R = returns_xts, weights = optimal_weights, : NA's
## detected: filling NA's with zeros
colnames(portfolio_returns) <- "Portfolio"

# Combine Portfolio + Benchmark
combined_returns <- merge(
  portfolio_returns,
  benchmark_returns
)

combined_returns <- na.omit(combined_returns)

7. Performance Statistics

# Annualized Return / Volatility / Sharpe
table.AnnualizedReturns(combined_returns)
##                           Portfolio    SPY
## Annualized Return            0.2476 0.2285
## Annualized Std Dev           0.1528 0.1513
## Annualized Sharpe (Rf=0%)    1.6203 1.5098
# CAGR
Return.annualized(portfolio_returns)
##                   Portfolio
## Annualized Return 0.2475653
# Volatility
StdDev.annualized(portfolio_returns)
##                               Portfolio
## Annualized Standard Deviation 0.1527871
# Sharpe Ratio
SharpeRatio.annualized(portfolio_returns)
##                                         Portfolio
## Annualized Sharpe Ratio (Rf=0%, p=95%):  1.524496
# Maximum Drawdown
maxDrawdown(portfolio_returns)
## [1] 0.1851178

8. Alpha & Beta Regression (CAPM)

CAPM.alpha(
  Ra = portfolio_returns,
  Rb = benchmark_returns
)
## [1] 9.67144e-05
CAPM.beta(
  Ra = portfolio_returns,
  Rb = benchmark_returns
)
## [1] 0.9601601

9. Equity Curve Visualization

charts.PerformanceSummary(
  combined_returns,
  main = "Portfolio vs SPY Benchmark"
)

10. Drawdown Chart

# Calculate drawdowns
drawdown_data <- data.frame(
  date = index(portfolio_returns),
  drawdown = as.numeric(Drawdowns(portfolio_returns))
)

# Enhanced ggplot chart
ggplot(drawdown_data, aes(x = date, y = drawdown)) +
  
  # Filled drawdown area
  geom_area(
    fill = "#D73027",
    alpha = 0.35
  ) +
  
  # Drawdown line
  geom_line(
    color = "#A50026",
    linewidth = 1.2
  ) +
  
  # Zero reference line
  geom_hline(
    yintercept = 0,
    linetype = "dashed",
    color = "gray40"
  ) +
  
  labs(
    title = "Portfolio Drawdown Over Time",
    x = "Date",
    y = "Drawdown"
  ) +
  
  scale_y_continuous(
    labels = scales::percent_format(accuracy = 1)
  ) +
  
  theme_minimal(base_size = 14) +
  
  theme(
    plot.title = element_text(
      face = "bold",
      size = 18
    ),
    
    plot.subtitle = element_text(
      size = 12,
      color = "gray30"
    ),
    
    axis.title = element_text(
      face = "bold"
    ),
    
    panel.grid.minor = element_blank(),
    
    panel.grid.major.x = element_blank()
  )