Project 02
Md.Shohan Hossain
2024-04-16
Protfolio Using R
stocks <- c("META", "TSLA", "GOOGL", "PEP", "AMZN")
getSymbols(stocks, from = "2014-01-01", to = "2023-12-29", src = "yahoo")## [1] "META" "TSLA" "GOOGL" "PEP" "AMZN"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)(5 US Stock Data are taken from Yahoo finance)
#Equal Weighted Portfolio
ew <- rep(1/5,5)
equalWeight.portfolio <- getPortfolio(er = mu.vec, cov.mat = sigma.mat, weights = ew)
plot(equalWeight.portfolio, col="red")
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='violet', xlab="Standard Deviation (Risk)", ylab="Expected Return", main="Efficient Frontier")
points(sqrt(diag(sigma.mat)), mu.vec, pch=19, col='black')
#### 3. Making protfolio
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='violet', xlab="Standard Deviation", ylab="Expected Return", main="Efficient Frontier")
points(sqrt(diag(sigma.mat)), mu.vec, pch=19, col='black', labels=names(mu.vec))
points(tan.port$sd, tan.port$er, col="black", 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="blue", lwd=2, lty=2)
legend("topright", legend=c("Efficient Frontier", "Individual Assets", "Tangency Portfolio", "CML"),
col=c("violet", "black", "black", "blue"), pch=c(NA, 19, 16, NA), lty=c(1, NA, NA, 2))
#### 4. Perdormance Analytics (annualized return & volatility)
# Using Performance Analytics
stock_data <- lapply(stocks, function(sym) {
getSymbols(sym, from = "2020-01-01", to = "2022-12-29", auto.assign = FALSE)
})
prices <- lapply(stock_data, Ad)
all_prices <- do.call(merge, prices)
names(all_prices) <- stocks
head(all_prices)## META TSLA GOOGL PEP AMZN
## 2020-01-02 209.5576 28.68400 68.4340 120.4818 94.9005
## 2020-01-03 208.4488 29.53400 68.0760 120.3132 93.7485
## 2020-01-06 212.3747 30.10267 69.8905 120.7745 95.1440
## 2020-01-07 212.8342 31.27067 69.7555 118.8762 95.3430
## 2020-01-08 214.9919 32.80933 70.2520 119.4883 94.5985
## 2020-01-09 218.0686 32.08933 70.9895 119.5681 95.0525# 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 (META)")## Error in plot.window(...): need finite 'xlim' valuesplot.zoo(eop_weight_rebal$AAPL, main = "End of Period Weights - Monthly Rebalanced (META)")## Error in plot.window(...): need finite 'xlim' values
# Fetch price
sp500 <- getSymbols("^GSPC", from = "2014-01-01", to = "2023-12-29", 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# the daily frequency cpnverted sp500 to monthly frequency
sp500_monthly <- to.monthly(sp500)
# Print the first six rows of sp500_monthly
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.23# Create sp500_returns using Return also closing price
sp500_returns <- Return.calculate(Cl(sp500_monthly))
# Time series plot
plot.ts(sp500_returns)
# year x month
table.CalendarReturns(sp500_returns)## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec sp500.Close
## 2014 NA 4.3 0.7 0.6 2.1 1.9 -1.5 3.8 -1.6 2.3 2.5 -0.4 15.5
## 2015 -3.1 5.5 -1.7 0.9 1.0 -2.1 2.0 -6.3 -2.6 8.3 0.1 -1.8 -0.7
## 2016 -5.1 -0.4 6.6 0.3 1.5 0.1 3.6 -0.1 -0.1 -1.9 3.4 1.8 9.5
## 2017 1.8 3.7 0.0 0.9 1.2 0.5 1.9 0.1 1.9 2.2 2.8 1.0 19.4
## 2018 5.6 -3.9 -2.7 0.3 2.2 0.5 3.6 3.0 0.4 -6.9 1.8 -9.2 -6.2
## 2019 7.9 3.0 1.8 3.9 -6.6 6.9 1.3 -1.8 1.7 2.0 3.4 2.9 28.9
## 2020 -0.2 -8.4 -12.5 12.7 4.5 1.8 5.5 7.0 -3.9 -2.8 10.8 3.7 16.3
## 2021 -1.1 2.6 4.2 5.2 0.5 2.2 2.3 2.9 -4.8 6.9 -0.8 4.4 26.9
## 2022 -5.3 -3.1 3.6 -8.8 0.0 -8.4 9.1 -4.2 -9.3 8.0 5.4 -5.9 -19.4
## 2023 6.2 -2.6 3.5 1.5 0.2 6.5 3.1 -1.8 -4.9 -2.2 8.9 4.7 24.6# Remove first value because it is NA
sp500_returns <- sp500_returns[(-1),]
# the mean monthly returns
mean(sp500_returns)## [1] 0.009284533# geometric mean of monthly returns
mean.geometric(sp500_returns)## sp500.Close
## Geometric Mean 0.008329235# standard deviation
sd(sp500_returns)## [1] 0.04380469# Annualized mean and volatility
table.AnnualizedReturns(sp500_returns)## sp500.Close
## Annualized Return 0.1047
## Annualized Std Dev 0.1517
## Annualized Sharpe (Rf=0%) 0.6897# 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")
# Total:
charts.RollingPerformance(R = sp500_returns, width = 12)
# To analyze specific date range
# Use daily return
sp500_ret_daily <- Return.calculate(Cl(sp500))
# Create specific years
sp500_2014 <- window(sp500_ret_daily, start = "2014-01-01", end = "2014-12-29")
sp500_2023 <- window(sp500_ret_daily, start = "2023-01-01", end = "2023-12-29")
# Plotting settings
par(mfrow = c(1, 2), mar = c(3, 2, 2, 2))
names(sp500_2014) <- "sp500_2014"
names(sp500_2023) <- "sp500_2023"
## Compare Density Chart with Normal Chart
# Plotting histogram of 2014
chart.Histogram(sp500_2014, methods = c("add.density", "add.normal"))
# Plotting histogram of 2023
chart.Histogram(sp500_2023, methods = c("add.density", "add.normal"))
## Both skewness and kurtosis
skewness(sp500_ret_daily) ## [1] -0.5228842kurtosis(sp500_ret_daily) ## [1] 14.86335# Semi-deviation, Value-at-Risk and 5% Expected Shortfall
SemiDeviation(sp500_returns)## sp500.Close
## Semi-Deviation 0.03255194VaR(sp500_returns, p = 0.05)## sp500.Close
## VaR -0.06637531ES(sp500_returns, p = 0.05)## sp500.Close
## ES -0.0928014# Analyzing the drawdowns
table.Drawdowns(sp500_ret_daily)## From Trough To Depth Length To Trough Recovery
## 1 2020-02-20 2020-03-23 2020-08-18 -0.3392 126 23 103
## 2 2022-01-04 2022-10-12 <NA> -0.2543 500 195 NA
## 3 2018-09-21 2018-12-24 2019-04-23 -0.1978 146 65 81
## 4 2015-05-22 2016-02-11 2016-07-11 -0.1416 286 183 103
## 5 2018-01-29 2018-02-08 2018-08-24 -0.1016 146 9 137par(mfrow=c(1,1))
chart.Drawdown(sp500_ret_daily)
meta <- getSymbols("META", from = "2014-01-01", to = "2023-12-29", auto.assign = FALSE)
tsla <- getSymbols("TSLA", from = "2014-01-01", to = "2023-12-29", auto.assign = FALSE)
# Adjusting closing prices
meta_ad <- Ad(meta)
tsla_ad <- Ad(tsla)
# Calculate returns
meta_ret <- Return.calculate(meta_ad)
tsla_ret <- Return.calculate(tsla_ad)
# Remove the first row
meta_ret <- meta_ret[-1,]
tsla_ret <- tsla_ret[-1,]
# scatter plot of returns
chart.Scatter(meta_ret, tsla_ret, xlab = "META returns", ylab = "TSLA returns", main = "META-TSLA returns")
# correlation
meta_tsla_cor <- cor(meta_ret, tsla_ret)
print(meta_tsla_cor)## TSLA.Adjusted
## META.Adjusted 0.3497284# Find and visualize the correlation
chart.Correlation(cbind(meta_ret, tsla_ret))
# Visualize the rolling estimates
par(mfrow = c(2, 1))
chart.RollingCorrelation(meta_ret, meta_ret, width = 20)
chart.RollingCorrelation(tsla_ret, tsla_ret, width = 251) 
# Plot parameters
par(mfrow = c(1, 1))# Load data for specified stocks
meta <- getSymbols("META", from = "2004-01-01", to = "2014-10-29", auto.assign = FALSE)
tsla <- getSymbols("TSLA", from = "2004-01-01", to = "2014-10-29", auto.assign = FALSE)
googl <- getSymbols("GOOGL", from = "2004-01-01", to = "2014-10-29", auto.assign = FALSE)
pep <- getSymbols("PEP", from = "2004-01-01", to = "2014-10-29", auto.assign = FALSE)
amzn <- getSymbols("AMZN", from = "2004-01-01", to = "2014-10-29", auto.assign = FALSE)
# Calculate returns
ret_meta <- Return.calculate(Ad(meta))
ret_tsla <- Return.calculate(Ad(tsla))
ret_googl <- Return.calculate(Ad(googl))
ret_pep <- Return.calculate(Ad(pep))
ret_amzn <- Return.calculate(Ad(amzn))
# Reduce NA in the first row
ret_meta <- ret_meta[-1,]
ret_tsla <- ret_tsla[-1,]
ret_googl <- ret_googl[-1,]
ret_pep <- ret_pep[-1,]
ret_amzn <- ret_amzn[-1,]
# Combination returns into a matrix
return_multi <- cbind(ret_meta, ret_tsla, ret_googl, ret_pep, ret_amzn)
# Means and standard deviations of returns
means <- colMeans(return_multi)
sds <- apply(return_multi, 2, sd)
# Ensure the plot is executed in one block without interruptions
plot(sds, means, pch = 19, col = "violet", xlab = "Standard Deviation", ylab = "Mean Return")
text(sds, means, labels = colnames(return_multi), pos = 3, cex = 0.8)
abline(h = 0.0006, col = "black", lty = 2) # Horizontal reference line
# Create a matrix with variances on the diagonal
diag_cov <- diag(sds^2)
# Compute the covariance and correlation matrices
cov_matrix <- cov(return_multi)
cor_matrix <- cor(return_multi)
# Portfolio analysis
weights <- c(0.2, 0.2, 0.2, 0.2, 0.2) # Equal weighting for simplicity
# 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
## META.Adjusted 0.2 0.29091575
## TSLA.Adjusted 0.2 0.38594202
## GOOGL.Adjusted 0.2 0.11769157
## PEP.Adjusted 0.2 0.03530626
## AMZN.Adjusted 0.2 0.17014439# Portfolio specification
port_spec <- portfolio.spec(assets = colnames(return_multi))
# Investment constraint such that the weights sum to 1
port_spec <- add.constraint(portfolio = port_spec, type = "full_investment")
# Long only constraint such that each weight is between 0 and 1
port_spec <- add.constraint(portfolio = port_spec, type = "long_only")
# 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")## Error in gmv_opt(R = R, constraints = constraints, moments = moments, : "package:ROI" %in% search() || requireNamespace("ROI", quietly = TRUE) is not TRUE# Print the results
opt## Error in eval(expr, envir, enclos): object 'opt' not found# The optimal weights
optimal_weights <- extractWeights(opt)## Error in eval(expr, envir, enclos): object 'opt' not foundchart.Weights(opt)## Error in eval(expr, envir, enclos): object 'opt' not found# More specific optimization with return and risk
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")## Error in gmv_opt(R = R, constraints = constraints, moments = moments, : "package:ROI" %in% search() || requireNamespace("ROI", quietly = TRUE) is not TRUEextractWeights(opt1)## Error in eval(expr, envir, enclos): object 'opt1' not foundchart.Weights(opt1)## Error in eval(expr, envir, enclos): object 'opt1' not found# Risk-budgeted portfolio
port_spec <- add.objective(portfolio = port_spec, type = "risk_budget", name = "StdDev", min_prisk = 0.06, max_prisk = 0.1)
# Optimize the portfolio
opt2 <- optimize.portfolio.rebalancing(return_multi, portfolio = port_spec, optimize_method = "random", trace = F, search_size = 1500, rebalance_on = "quarters")
# Print the results and chart the optimal weights
extractWeights(opt2)## META.Adjusted TSLA.Adjusted GOOGL.Adjusted PEP.Adjusted
## 2012-09-28 0.156 0.088 0.39 0.264
## 2012-12-31 0.156 0.088 0.39 0.264
## 2013-03-28 0.156 0.088 0.39 0.264
## 2013-06-28 0.156 0.088 0.39 0.264
## 2013-09-30 0.156 0.088 0.39 0.264
## 2013-12-31 0.156 0.088 0.39 0.264
## 2014-03-31 0.156 0.088 0.39 0.264
## 2014-06-30 0.156 0.088 0.39 0.264
## 2014-09-30 0.156 0.088 0.39 0.264
## 2014-10-28 0.156 0.088 0.39 0.264
## AMZN.Adjusted
## 2012-09-28 0.102
## 2012-12-31 0.102
## 2013-03-28 0.102
## 2013-06-28 0.102
## 2013-09-30 0.102
## 2013-12-31 0.102
## 2014-03-31 0.102
## 2014-06-30 0.102
## 2014-09-30 0.102
## 2014-10-28 0.102chart.Weights(opt2)
# Objective Measures
objective_measures <- extractObjectiveMeasures(opt2)
objective_measures## StdDev StdDev.contribution.META.Adjusted
## 2012-09-28 0.010375512 0.003770275
## 2012-12-31 0.010248360 0.003825761
## 2013-03-28 0.009992099 0.003462362
## 2013-06-28 0.010140212 0.002997028
## 2013-09-30 0.010073058 0.003312682
## 2013-12-31 0.010451981 0.003163557
## 2014-03-31 0.010879444 0.003242234
## 2014-06-30 0.011092788 0.003239132
## 2014-09-30 0.010942496 0.003127407
## 2014-10-28 0.010988883 0.003086022
## StdDev.contribution.TSLA.Adjusted StdDev.contribution.GOOGL.Adjusted
## 2012-09-28 0.001494549 0.003522491
## 2012-12-31 0.001189778 0.003810466
## 2013-03-28 0.001214610 0.003743446
## 2013-06-28 0.001638624 0.003763076
## 2013-09-30 0.001632816 0.003374152
## 2013-12-31 0.001628535 0.003886124
## 2014-03-31 0.001740340 0.003991670
## 2014-06-30 0.001744950 0.004174452
## 2014-09-30 0.001692996 0.004138115
## 2014-10-28 0.001713053 0.004191487
## StdDev.contribution.PEP.Adjusted StdDev.contribution.AMZN.Adjusted
## 2012-09-28 0.0006410906 0.0009471066
## 2012-12-31 0.0004926435 0.0009297124
## 2013-03-28 0.0006199558 0.0009517244
## 2013-06-28 0.0007865994 0.0009548841
## 2013-09-30 0.0008375544 0.0009158545
## 2013-12-31 0.0007938417 0.0009799232
## 2014-03-31 0.0008779235 0.0010272773
## 2014-06-30 0.0008048586 0.0011293954
## 2014-09-30 0.0008331649 0.0011508138
## 2014-10-28 0.0008352123 0.0011631088
## StdDev.pct_contrib_StdDev.META.Adjusted
## 2012-09-28 0.3633821
## 2012-12-31 0.3733046
## 2013-03-28 0.3465100
## 2013-06-28 0.2955587
## 2013-09-30 0.3288656
## 2013-12-31 0.3026754
## 2014-03-31 0.2980146
## 2014-06-30 0.2920034
## 2014-09-30 0.2858038
## 2014-10-28 0.2808313
## StdDev.pct_contrib_StdDev.TSLA.Adjusted
## 2012-09-28 0.1440458
## 2012-12-31 0.1160944
## 2013-03-28 0.1215571
## 2013-06-28 0.1615966
## 2013-09-30 0.1620973
## 2013-12-31 0.1558112
## 2014-03-31 0.1599659
## 2014-06-30 0.1573049
## 2014-09-30 0.1547175
## 2014-10-28 0.1558896
## StdDev.pct_contrib_StdDev.GOOGL.Adjusted
## 2012-09-28 0.3395004
## 2012-12-31 0.3718123
## 2013-03-28 0.3746406
## 2013-06-28 0.3711043
## 2013-09-30 0.3349679
## 2013-12-31 0.3718074
## 2014-03-31 0.3669001
## 2014-06-30 0.3763213
## 2014-09-30 0.3781692
## 2014-10-28 0.3814298
## StdDev.pct_contrib_StdDev.PEP.Adjusted
## 2012-09-28 0.06178881
## 2012-12-31 0.04807047
## 2013-03-28 0.06204460
## 2013-06-28 0.07757229
## 2013-09-30 0.08314798
## 2013-12-31 0.07595132
## 2014-03-31 0.08069562
## 2014-06-30 0.07255693
## 2014-09-30 0.07614030
## 2014-10-28 0.07600521
## StdDev.pct_contrib_StdDev.AMZN.Adjusted mean
## 2012-09-28 0.09128288 0.0006507189
## 2012-12-31 0.09071816 0.0005431544
## 2013-03-28 0.09524769 0.0008699676
## 2013-06-28 0.09416806 0.0012342458
## 2013-09-30 0.09092119 0.0015300810
## 2013-12-31 0.09375478 0.0016332639
## 2014-03-31 0.09442369 0.0015057469
## 2014-06-30 0.10181349 0.0014681109
## 2014-09-30 0.10516922 0.0013884396
## 2014-10-28 0.10584413 0.0013172142