knitr::opts_chunk$set(echo = TRUE)
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)
## 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)
## Warning: package 'ROI.plugin.quadprog' was built under R version 4.5.3
# 1. Define Defensive Tickers and Benchmark
tickers <- c('PG', 'KO', 'JNJ', 'NEE', 'JPM', 'XOM')
benchmark_ticker <- 'SPY'
start_date <- Sys.Date() - years(3)
# 2. Pull and Format Returns
prices <- tq_get(tickers, from = start_date, get = "stock.prices")
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)
returns_multi <- na.omit(xts(returns_wide[,-1], order.by = as.Date(returns_wide$date)))
# 3. Formulate Global Minimum Variance Constraints (Min Volatility)
port_spec <- portfolio.spec(assets = tickers) %>%
add.constraint(type = "full_investment") %>%
add.constraint(type = "long_only") %>%
add.constraint(type = "box", min = 0.05, max = 0.25) %>% # Min 5%, Max 25% for diversification
add.objective(type = "risk", name = "StdDev") # Objective: MINIMIZE Volatility Only
# 4. Optimize
opt_weights <- optimize.portfolio(R = returns_multi, portfolio = port_spec, optimize_method = "ROI")
portfolio_weights <- extractWeights(opt_weights)
# 5. Run Backtest vs Benchmark
portfolio_returns <- Return.portfolio(returns_multi, weights = portfolio_weights)
colnames(portfolio_returns) <- "Defensive_LowVol_Portfolio"
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 = "SPY")
benchmark_returns <- xts(benchmark_wide$SPY, order.by = as.Date(benchmark_wide$date))
combined_returns <- na.omit(merge.xts(portfolio_returns, benchmark_returns))
# 6. Performance Reports
print(table.AnnualizedReturns(combined_returns))
## Defensive_LowVol_Portfolio benchmark_returns
## Annualized Return 0.1736 0.2285
## Annualized Std Dev 0.1144 0.1513
## Annualized Sharpe (Rf=0%) 1.5177 1.5098
print(table.DownsideRisk(combined_returns))
## Defensive_LowVol_Portfolio benchmark_returns
## Semi Deviation 0.0052 0.0067
## Gain Deviation 0.0047 0.0070
## Loss Deviation 0.0051 0.0072
## Downside Deviation (MAR=210%) 0.0103 0.0113
## Downside Deviation (Rf=0%) 0.0049 0.0064
## Downside Deviation (0%) 0.0049 0.0064
## Maximum Drawdown 0.1021 0.1876
## Historical VaR (95%) -0.0108 -0.0141
## Historical ES (95%) -0.0151 -0.0210
## Modified VaR (95%) -0.0112 -0.0078
## Modified ES (95%) -0.0219 -0.0078
cat("Beta:", CAPM.beta(portfolio_returns, benchmark_returns), "\n")
## Beta: 0.3283651
cat("Alpha (Ann.):", CAPM.alpha(portfolio_returns, benchmark_returns) * 252, "\n")
## Alpha (Ann.): 0.09531583