R for finance Project 02
Md. Fazle Rabbi
2024-04-13
Protfolio Using R
1.Libraries Setup:
*** Note: First of all, I loaded the packages I intent to use during the whole project; which are essential for financial data downloading, manipulation, and portfolio optimization.***
library(quantmod)
library(PortfolioAnalytics)
library(IntroCompFinR)
library(tidyquant)
library(PerformanceAnalytics)2.Data Acquisition and Preparation:
*** Note: I selected 5 US stocks and retrieved prices using the ‘getSymbols’ function from Yahoo Finance and converted the stock prices to adjusted closing prices and compute the returns. ***
stocks <- c("AAPL", "MSFT", "GOOG", "AMZN", "NVDA")
getSymbols(stocks, from = "2014-01-01", to = "2023-12-31", src = "yahoo")## [1] "AAPL" "MSFT" "GOOG" "AMZN" "NVDA"prices <- do.call(cbind, lapply(stocks, function(stock) Ad(get(stock))))
colnames(prices) <- stocks
returns <- na.omit(Return.calculate(prices))
mu.vec <- colMeans(returns)
sigma.mat <- cov(returns)3.Portfolio Construction:
a. Equal Weighted Portfolio and Efficient Frontier:
*** Note: Here I created an equal-weighted portfolio from the selected stocks and calculated its returns and plotted the portfolio’s performance ***
#Equal Weighted Portfolio
ew <- rep(1/5,5)
equalWeight.portfolio <- getPortfolio(er = mu.vec, cov.mat = sigma.mat, weights = ew)
plot(equalWeight.portfolio, col="steelblue")
average_return <- mean(mu.vec)
portfolio_return <- sum(ew * mu.vec)
# Efficient Frontier
ef <- efficient.frontier(mu.vec,sigma.mat, nport = 50)
plot(ef$sd, ef$er, type='l', col='blue', xlab="Standard Deviation (Risk)", ylab="Expected Return", main="Efficient Frontier")
points(sqrt(diag(sigma.mat)), mu.vec, pch=19, col='red')
b. Tangency Portfolio and Efficient Frontier:
*** Note: I showed the calculation and plotted the efficient frontier, and found the tangency portfolio that maximizes the Sharpe ratio.***
r.f <- 0.0005
# Tangency Portfolio
ef <- efficient.frontier(mu.vec, sigma.mat, alpha.min=-0.5, alpha.max=2, nport=50)
tan.port <- tangency.portfolio(mu.vec, sigma.mat, r.f)
# Efficient Frontier
plot(ef$sd, ef$er, type='l', col='blue', xlab="Standard Deviation", ylab="Expected Return", main="Efficient Frontier")
points(sqrt(diag(sigma.mat)), mu.vec, pch=19, col='red', labels=names(mu.vec))
points(tan.port$sd, tan.port$er, col="red", pch=16, cex=2)
text(tan.port$sd, tan.port$er, labels="Tangency", pos=3)
sr.tan <- (tan.port$er - r.f) / tan.port$sd
abline(a=r.f, b=sr.tan, col="green", lwd=2, lty=2)
legend("topright", legend=c("Efficient Frontier", "Individual Assets", "Tangency Portfolio", "CML"),
col=c("blue", "red", "red", "green"), pch=c(NA, 19, 16, NA), lty=c(1, NA, NA, 2))
4.Performance Analytics:
*** Note: Here, by using the PerformanceAnalytics package, I compared the performance of a buy and hold strategy versus a monthly rebalanced portfolio, illustrating the impact of rebalancing on portfolio returns. And showed how to perform a rolling analysis of performance metrics like annualized returns and volatility.***
# Using Performance Analytics
stock_data <- lapply(stocks, function(sym) {
getSymbols(sym, from = "2020-01-01", to = "2022-12-31", auto.assign = FALSE)
})
prices <- lapply(stock_data, Ad)
all_prices <- do.call(merge, prices)
names(all_prices) <- stocks
head(all_prices)## AAPL MSFT GOOG AMZN NVDA
## 2020-01-02 73.05943 154.4939 68.3685 94.9005 59.74124
## 2020-01-03 72.34913 152.5701 68.0330 93.7485 58.78502
## 2020-01-06 72.92563 152.9645 69.7105 95.1440 59.03154
## 2020-01-07 72.58266 151.5698 69.6670 95.3430 59.74622
## 2020-01-08 73.75024 153.9840 70.2160 94.5985 59.85827
## 2020-01-09 75.31677 155.9078 70.9915 95.0525 60.51568# Calculate returns
returns <- na.omit(Return.calculate(all_prices))
equal_weights <- rep(1/5,5)
pf_bh <- Return.portfolio(R = returns, weights = equal_weights, verbose = TRUE)
pf_rebal <- Return.portfolio(R = returns, weights = equal_weights, rebalance_on = "months", verbose = TRUE)
par(mfrow = c(2, 1), mar = c(2, 4, 2, 2))
plot.zoo(pf_bh$returns, main = "Buy and Hold Portfolio Returns")
plot.zoo(pf_rebal$returns, main = "Monthly Rebalanced Portfolio Returns")
eop_weight_bh <- pf_bh$EOP.Weight
eop_weight_rebal <- pf_rebal$EOP.Weight
par(mfrow = c(2, 1), mar = c(2, 4, 2, 2))
plot.zoo(eop_weight_bh$AAPL, main = "End of Period Weights - Buy and Hold (AAPL)")
plot.zoo(eop_weight_rebal$AAPL, main = "End of Period Weights - Monthly Rebalanced (AAPL)")
5. Risk and Return Assessment of sp500:
*** Note: I calculated and interpreted Standard Deviation, Value-at-Risk, and Expected Shortfall risk metrics for the S&P 500, providing insights into the risk profile of the market.***
sp500 <- getSymbols("^GSPC", from = "2014-01-01", to = "2023-12-31", src = "yahoo", auto.assign = FALSE)
head(sp500)## GSPC.Open GSPC.High GSPC.Low GSPC.Close GSPC.Volume GSPC.Adjusted
## 2014-01-02 1845.86 1845.86 1827.74 1831.98 3080600000 1831.98
## 2014-01-03 1833.21 1838.24 1829.13 1831.37 2774270000 1831.37
## 2014-01-06 1832.31 1837.16 1823.73 1826.77 3294850000 1826.77
## 2014-01-07 1828.71 1840.10 1828.71 1837.88 3511750000 1837.88
## 2014-01-08 1837.90 1840.02 1831.40 1837.49 3652140000 1837.49
## 2014-01-09 1839.00 1843.23 1830.38 1838.13 3581150000 1838.13# Convert the daily frequency of sp500 to monthly frequency
sp500_monthly <- to.monthly(sp500)
head(sp500_monthly)## sp500.Open sp500.High sp500.Low sp500.Close sp500.Volume
## Jan 2014 1845.86 1850.84 1770.45 1782.59 75871910000
## Feb 2014 1782.68 1867.92 1737.92 1859.45 69725590000
## Mar 2014 1857.68 1883.97 1834.44 1872.34 71885030000
## Apr 2014 1873.96 1897.28 1814.36 1883.95 71595810000
## May 2014 1884.39 1924.03 1859.79 1923.57 63623630000
## Jun 2014 1923.87 1968.17 1915.98 1960.23 63283380000
## sp500.Adjusted
## Jan 2014 1782.59
## Feb 2014 1859.45
## Mar 2014 1872.34
## Apr 2014 1883.95
## May 2014 1923.57
## Jun 2014 1960.23sp500_returns <- Return.calculate(Cl(sp500_monthly))
plot.ts(sp500_returns)
table.CalendarReturns(sp500_returns)sp500_returns <- sp500_returns[(-1),]
mean(sp500_returns)## [1] 0.00925966# Geometric mean of monthly returns
mean.geometric(sp500_returns)## sp500.Close
## Geometric Mean 0.008305251# Standard deviation
sd(sp500_returns)## [1] 0.04378382# Annualized mean and volatility
table.AnnualizedReturns(sp500_returns)# Plotting the 12-month rolling annualized mean
chart.RollingPerformance(R = sp500_returns, width = 12, FUN = "Return.annualized")
# Plotting the 12-month rolling annualized standard deviation
chart.RollingPerformance(R = sp500_returns, width = 12, FUN = "StdDev.annualized")
# Plotting the 12-month rolling annualized Sharpe ratio, assuming rf = 0
chart.RollingPerformance(R = sp500_returns, width = 12, FUN = "SharpeRatio.annualized")
# To see all together:
charts.RollingPerformance(R = sp500_returns, width = 12)
# Using window to analyze specific date range
# Use daily return
sp500_ret_daily <- Return.calculate(Cl(sp500))
# Create windows for specific years
sp500_2014 <- window(sp500_ret_daily, start = "2014-01-01", end = "2014-12-31")
sp500_2023 <- window(sp500_ret_daily, start = "2023-01-01", end = "2023-12-31")
par(mfrow = c(1, 2), mar = c(3, 2, 2, 2))
names(sp500_2014) <- "sp500_2014"
names(sp500_2023) <- "sp500_2023"
## Here we can easily Compare Density Chart with Normal Chart Easily
# Plot histogram of 2014
chart.Histogram(sp500_2014, methods = c("add.density", "add.normal"))
# Plot histogram of 2023
chart.Histogram(sp500_2023, methods = c("add.density", "add.normal"))
## Calculate both skewness and kurtosis
skewness(sp500_ret_daily) #This is Negatively Skewed## [1] -0.5226222kurtosis(sp500_ret_daily) #Excess kurtosis is = 11.869## [1] 14.869# Semi-deviation, Value-at-Risk and 5% Expected Shortfall
SemiDeviation(sp500_returns)## sp500.Close
## Semi-Deviation 0.03253936VaR(sp500_returns, p = 0.05)## sp500.Close
## VaR -0.06636011ES(sp500_returns, p = 0.05)## sp500.Close
## ES -0.092819126. Drawdown Analysis:
*** Note: By using R, I evaluated the maximum drawdown periods which are critical for understanding potential losses in investment value.***
# Analyzing the drawdowns
table.Drawdowns(sp500_ret_daily)par(mfrow=c(1,1))
chart.Drawdown(sp500_ret_daily)
7. Correlation and Scatter Plots:
*** Note: Here I calculated correlation and created scatter plots to visualize return relationships of Apple and Microsoft***
aapl <- getSymbols("AAPL", from = "2014-01-01", to = "2023-12-31", auto.assign = FALSE)
msft <- getSymbols("MSFT", from = "2014-01-01", to = "2023-12-31", auto.assign = FALSE)
aapl_ad <- Ad(aapl)
msft_ad <- Ad(msft)
aapl_ret <- Return.calculate(aapl_ad)
msft_ret <- Return.calculate(msft_ad)
aapl_ret <- aapl_ret[-1,]
msft_ret <- msft_ret[-1,]
# Scatter plot of returns
chart.Scatter(aapl_ret, msft_ret, xlab = "AAPL returns", ylab = "MSFT returns", main = "AAPL-MSFT returns")
# Correlation
aapl_msft_cor <- cor(aapl_ret, msft_ret)
print(aapl_msft_cor)## MSFT.Adjusted
## AAPL.Adjusted 0.6711041# Visualizing the correlation using chart.Correlation
chart.Correlation(cbind(aapl_ret, msft_ret))
# Visualizing the rolling estimates using chart.Rolling Correlation
par(mfrow = c(2, 1))
chart.RollingCorrelation(aapl_ret, msft_ret, width = 22) # 22 trading days, about 1 calendar month
chart.RollingCorrelation(aapl_ret, msft_ret, width = 252) # 252 trading days, about 1 calendar year
par(mfrow = c(1, 1))8. Performance Analysis:
a. Risk-Return Profile Plot:
*** Note: I plotted the standard deviations (risk) against the mean returns (expected return) for each stock and added labels. I also included a horizontal reference line for mean return for visual reference.***
aapl <- getSymbols("AAPL", from = "2003-01-01", to = "2016-08-30", auto.assign = FALSE)
msft <- getSymbols("MSFT", from = "2003-01-01", to = "2016-08-30", auto.assign = FALSE)
goog <- getSymbols("GOOG", from = "2003-01-01", to = "2016-08-30", auto.assign = FALSE)
amzn <- getSymbols("AMZN", from = "2003-01-01", to = "2016-08-30", auto.assign = FALSE)
nvda <- getSymbols("NVDA", from = "2003-01-01", to = "2016-08-30", auto.assign = FALSE)
ret_aapl <- Return.calculate(Ad(aapl))
ret_msft <- Return.calculate(Ad(msft))
ret_goog <- Return.calculate(Ad(goog))
ret_amzn <- Return.calculate(Ad(amzn))
ret_nvda <- Return.calculate(Ad(nvda))
ret_aapl <- ret_aapl[-1,]
ret_msft <- ret_msft[-1,]
ret_goog <- ret_goog[-1,]
ret_amzn <- ret_amzn[-1,]
ret_nvda <- ret_nvda[-1,]
return_multi <- cbind(ret_aapl, ret_msft, ret_goog, ret_amzn, ret_nvda)
means <- colMeans(return_multi)
sds <- apply(return_multi, 2, sd)
# Plotting
plot(sds, means, pch = 19, col = "blue", xlab = "Standard Deviation", ylab = "Mean Return")
text(sds, means, labels = colnames(return_multi), pos = 3, cex = 0.8)
abline(h = 0.0006, col = "red", lty = 2) # Horizontal reference line
b. Covariance and Correlation Analysis:
*** Note: I computed and stored the covariance and correlation matrices of the returns. This is useful for understanding how stocks move in relation to one another. ***
# Creating a matrix with variances on the diagonal
diag_cov <- diag(sds^2)
# Computing the covariance and correlation matrices
cov_matrix <- cov(return_multi)
cor_matrix <- cor(return_multi)c. Volatility Budgeting:
*** Note: Volatility Budgeting shows the contribution of each asset to overall portfolio risk.
# Portfolio analysis
weights <- c(0.2, 0.2, 0.2, 0.2, 0.2) # Equal weighting for simplicity
# Create volatility budget
if(any(is.na(return_multi))) {
return_multi <- na.omit(return_multi)
}
vol_budget <- StdDev(return_multi, portfolio_method = "component", weights = weights)
weights_percrisk <- cbind(weights, vol_budget$pct_contrib_StdDev)
colnames(weights_percrisk) <- c("weights", "perc vol contrib")
weights_percrisk## weights perc vol contrib
## AAPL.Adjusted 0.2 0.1874538
## MSFT.Adjusted 0.2 0.1441373
## GOOG.Adjusted 0.2 0.1736469
## AMZN.Adjusted 0.2 0.2288430
## NVDA.Adjusted 0.2 0.26591909.Minimum Variance Portfolio with Constraints:
*** Note: I have made a Minimum variance portfolio and add “Constraints” so that 100% cash will be invested and there will be no negative weight. I used constraints like full investment and long-only positions. These optimizes the portfolio to achieve lowest possible risk. ***
# Create the portfolio specification
port_spec <- portfolio.spec(assets = colnames(return_multi))
# Add a full investment constraint such that the weights sum to 1
port_spec <- add.constraint(portfolio = port_spec, type = "full_investment")
# Add a long only constraint such that each weight is between 0 and 1
port_spec <- add.constraint(portfolio = port_spec, type = "long_only")
# Add an objective to minimize portfolio standard deviation
port_spec <- add.objective(portfolio = port_spec, type = "risk", name = "StdDev")
# Optimize the portfolio
opt <- optimize.portfolio(return_multi, portfolio = port_spec, optimize_method = "ROI")
# Print the results of the optimization
opt## ***********************************
## PortfolioAnalytics Optimization
## ***********************************
##
## Call:
## optimize.portfolio(R = return_multi, portfolio = port_spec, optimize_method = "ROI")
##
## Optimal Weights:
## AAPL.Adjusted MSFT.Adjusted GOOG.Adjusted AMZN.Adjusted NVDA.Adjusted
## 0.1821 0.5333 0.2467 0.0379 0.0000
##
## Objective Measure:
## StdDev
## 0.01497# Extract and chart the optimal weights
optimal_weights <- extractWeights(opt)
chart.Weights(opt)
# Create a more specific optimization with return and risk objectives
port_spec <- add.objective(portfolio = port_spec, type = "return", name = "mean")
port_spec <- add.objective(portfolio = port_spec, type = "risk", name = "var", risk_aversion = 10)
opt1 <- optimize.portfolio(return_multi, portfolio = port_spec, optimize_method = "ROI")
extractWeights(opt1)## AAPL.Adjusted MSFT.Adjusted GOOG.Adjusted AMZN.Adjusted NVDA.Adjusted
## 0.26882154 0.37258011 0.25747187 0.07414111 0.02698536chart.Weights(opt1)
# Considerations for a risk-budgeted portfolio
port_spec <- add.objective(portfolio = port_spec, type = "risk_budget", name = "StdDev", min_prisk = 0.05, max_prisk = 0.1)
# Optimize the portfolio with re-balancing
opt2 <- optimize.portfolio.rebalancing(return_multi, portfolio = port_spec, optimize_method = "random", trace = F, search_size = 1000, rebalance_on = "quarters")
extractWeights(opt2)## AAPL.Adjusted MSFT.Adjusted GOOG.Adjusted AMZN.Adjusted
## 2004-12-31 0.088 0.592 0.112 0.154
## 2005-03-31 0.088 0.592 0.112 0.154
## 2005-06-30 0.088 0.592 0.112 0.154
## 2005-09-30 0.200 0.200 0.200 0.200
## 2005-12-30 0.200 0.200 0.200 0.200
## 2006-03-31 0.094 0.338 0.098 0.226
## 2006-06-30 0.200 0.200 0.200 0.200
## 2006-09-29 0.200 0.200 0.200 0.200
## 2006-12-29 0.200 0.200 0.200 0.200
## 2007-03-30 0.200 0.200 0.200 0.200
## 2007-06-29 0.200 0.200 0.200 0.200
## 2007-09-28 0.200 0.200 0.200 0.200
## 2007-12-31 0.200 0.200 0.200 0.200
## 2008-03-31 0.200 0.200 0.200 0.200
## 2008-06-30 0.200 0.200 0.200 0.200
## 2008-09-30 0.200 0.200 0.200 0.200
## 2008-12-31 0.288 0.180 0.260 0.174
## 2009-03-31 0.288 0.180 0.260 0.174
## 2009-06-30 0.288 0.180 0.260 0.174
## 2009-09-30 0.288 0.180 0.260 0.174
## 2009-12-31 0.288 0.180 0.260 0.174
## 2010-03-31 0.288 0.180 0.260 0.174
## 2010-06-30 0.288 0.180 0.260 0.174
## 2010-09-30 0.288 0.180 0.260 0.174
## 2010-12-31 0.288 0.180 0.260 0.174
## 2011-03-31 0.288 0.180 0.260 0.174
## 2011-06-30 0.288 0.180 0.260 0.174
## 2011-09-30 0.288 0.180 0.260 0.174
## 2011-12-30 0.288 0.180 0.260 0.174
## 2012-03-30 0.288 0.180 0.260 0.174
## 2012-06-29 0.288 0.180 0.260 0.174
## 2012-09-28 0.288 0.180 0.260 0.174
## 2012-12-31 0.288 0.180 0.260 0.174
## 2013-03-28 0.288 0.180 0.260 0.174
## 2013-06-28 0.288 0.180 0.260 0.174
## 2013-09-30 0.288 0.180 0.260 0.174
## 2013-12-31 0.288 0.180 0.260 0.174
## 2014-03-31 0.288 0.180 0.260 0.174
## 2014-06-30 0.288 0.180 0.260 0.174
## 2014-09-30 0.288 0.180 0.260 0.174
## 2014-12-31 0.288 0.180 0.260 0.174
## 2015-03-31 0.288 0.180 0.260 0.174
## 2015-06-30 0.288 0.180 0.260 0.174
## 2015-09-30 0.288 0.180 0.260 0.174
## 2015-12-31 0.288 0.180 0.260 0.174
## 2016-03-31 0.288 0.180 0.260 0.174
## 2016-06-30 0.288 0.180 0.260 0.174
## 2016-08-29 0.288 0.180 0.260 0.174
## NVDA.Adjusted
## 2004-12-31 0.054
## 2005-03-31 0.054
## 2005-06-30 0.054
## 2005-09-30 0.200
## 2005-12-30 0.200
## 2006-03-31 0.244
## 2006-06-30 0.200
## 2006-09-29 0.200
## 2006-12-29 0.200
## 2007-03-30 0.200
## 2007-06-29 0.200
## 2007-09-28 0.200
## 2007-12-31 0.200
## 2008-03-31 0.200
## 2008-06-30 0.200
## 2008-09-30 0.200
## 2008-12-31 0.098
## 2009-03-31 0.098
## 2009-06-30 0.098
## 2009-09-30 0.098
## 2009-12-31 0.098
## 2010-03-31 0.098
## 2010-06-30 0.098
## 2010-09-30 0.098
## 2010-12-31 0.098
## 2011-03-31 0.098
## 2011-06-30 0.098
## 2011-09-30 0.098
## 2011-12-30 0.098
## 2012-03-30 0.098
## 2012-06-29 0.098
## 2012-09-28 0.098
## 2012-12-31 0.098
## 2013-03-28 0.098
## 2013-06-28 0.098
## 2013-09-30 0.098
## 2013-12-31 0.098
## 2014-03-31 0.098
## 2014-06-30 0.098
## 2014-09-30 0.098
## 2014-12-31 0.098
## 2015-03-31 0.098
## 2015-06-30 0.098
## 2015-09-30 0.098
## 2015-12-31 0.098
## 2016-03-31 0.098
## 2016-06-30 0.098
## 2016-08-29 0.098# Periodical Optimal weights Chart
chart.Weights(opt2)