#Investment Club Portfolio Analytics
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.1.2
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.6 v dplyr 1.0.7
## v tidyr 1.2.0 v stringr 1.4.0
## v readr 2.1.2 v forcats 0.5.1
## Warning: package 'ggplot2' was built under R version 4.1.2
## Warning: package 'tibble' was built under R version 4.1.2
## Warning: package 'tidyr' was built under R version 4.1.2
## Warning: package 'readr' was built under R version 4.1.2
## Warning: package 'purrr' was built under R version 4.1.2
## Warning: package 'dplyr' was built under R version 4.1.2
## Warning: package 'stringr' was built under R version 4.1.2
## Warning: package 'forcats' was built under R version 4.1.2
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(quantmod)
## Warning: package 'quantmod' was built under R version 4.1.3
## Loading required package: xts
## Warning: package 'xts' was built under R version 4.1.2
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.1.2
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## Attaching package: 'xts'
## The following objects are masked from 'package:dplyr':
##
## first, last
## Loading required package: TTR
## Warning: package 'TTR' was built under R version 4.1.2
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(languageserver)
## Warning: package 'languageserver' was built under R version 4.1.2
library(TTR)
library(PerformanceAnalytics)
## Warning: package 'PerformanceAnalytics' was built under R version 4.1.2
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
library(PMwR)
## Warning: package 'PMwR' was built under R version 4.1.2
library(tidyquant)
## Warning: package 'tidyquant' was built under R version 4.1.2
## Loading required package: lubridate
## Warning: package 'lubridate' was built under R version 4.1.2
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
## == Need to Learn tidyquant? ====================================================
## Business Science offers a 1-hour course - Learning Lab #9: Performance Analysis & Portfolio Optimization with tidyquant!
## </> Learn more at: https://university.business-science.io/p/learning-labs-pro </>
library(writexl)
## Warning: package 'writexl' was built under R version 4.1.3
library(highcharter)
## Warning: package 'highcharter' was built under R version 4.1.2
## Highcharts (www.highcharts.com) is a Highsoft software product which is
## not free for commercial and Governmental use
library(PortfolioAnalytics)
## Warning: package 'PortfolioAnalytics' was built under R version 4.1.3
## Loading required package: foreach
## Warning: package 'foreach' was built under R version 4.1.3
##
## Attaching package: 'foreach'
## The following objects are masked from 'package:purrr':
##
## accumulate, when
library(ROI)
## Warning: package 'ROI' was built under R version 4.1.2
## Registered S3 method overwritten by 'ROI':
## method from
## print.constraint PortfolioAnalytics
## ROI: R Optimization Infrastructure
## Registered solver plugins: nlminb, glpk, quadprog, symphony.
## 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.1.2
library(ROI.plugin.glpk)
## Warning: package 'ROI.plugin.glpk' was built under R version 4.1.2
library(ROI.plugin.symphony)
## Warning: package 'ROI.plugin.symphony' was built under R version 4.1.2
library(plotly)
## Warning: package 'plotly' was built under R version 4.1.2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(parallel)
library(Rblpapi)
## Warning: package 'Rblpapi' was built under R version 4.1.3
## Rblpapi version 0.3.13 using Blpapi headers 3.8.18.1 and run-time 3.8.18.1.
## Please respect the Bloomberg licensing agreement and terms of service.
library(xts)
library(purrr)
library(pbapply)
## Warning: package 'pbapply' was built under R version 4.1.3
library(DEoptim)
## Warning: package 'DEoptim' was built under R version 4.1.3
##
## DEoptim package
## Differential Evolution algorithm in R
## Authors: D. Ardia, K. Mullen, B. Peterson and J. Ulrich
library(foreach)
library(doParallel)
## Warning: package 'doParallel' was built under R version 4.1.3
## Loading required package: iterators
## Warning: package 'iterators' was built under R version 4.1.3
library(memisc)
## Warning: package 'memisc' was built under R version 4.1.3
## Loading required package: lattice
## Loading required package: MASS
##
## Attaching package: 'MASS'
## The following object is masked from 'package:plotly':
##
## select
## The following object is masked from 'package:dplyr':
##
## select
## Registered S3 method overwritten by 'memisc':
## method from
## toLatex.data.frame textutils
##
## Attaching package: 'memisc'
## The following objects are masked from 'package:plotly':
##
## rename, style
## The following object is masked from 'package:foreach':
##
## foreach
## The following object is masked from 'package:lubridate':
##
## is.interval
## The following object is masked from 'package:PerformanceAnalytics':
##
## StdDev
## The following objects are masked from 'package:dplyr':
##
## collect, recode, rename, syms
## The following object is masked from 'package:purrr':
##
## %@%
## The following object is masked from 'package:tibble':
##
## view
## The following object is masked from 'package:ggplot2':
##
## syms
## The following objects are masked from 'package:stats':
##
## contr.sum, contr.treatment, contrasts
## The following object is masked from 'package:base':
##
## as.array
library(readxl)
## Warning: package 'readxl' was built under R version 4.1.2
registerDoParallel(cores = 8)
.storage <<- new.env()
#get tickers and asset weights
Tickers <-
c(
"ADDYY",
"AL",
"BABA",
"AMZN",
"AAPL",
"CSCO",
"CMCSA",
"STZ",
"CCI",
"CMI",
"DKNG",
"JPM",
"MSFT",
"NIO",
"NVDA",
"PYPL",
"AOS",
"TJX",
"VZ",
"WMT",
"DIS",
"WELL",
"QQQ",
"SPY",
"ANGL",
"VWO",
"VHT"
)
Weights <-
c(
0.00940302323729867,
0.013655334967535,
0.0214396023563627,
0.0520033638248402,
0.09406032859821,
0.0211894677055033,
0.0361116374696608,
0.0470991029672455,
0.0187505189631285,
0.0686810518329937,
0.00530131378796914,
0.0455550156213055,
0.0828464531183291,
0.00386862898648931,
0.0281678101268591,
0.00409772826129965,
0.0356664135032516,
0.0375466602238111,
0.0279155840583979,
0.0541846004306968,
0.0251229787738308,
0.0209921878317216,
0.0617534889763587,
0.0587234675070793,
0.0308428342079141,
0.0400120928875949,
0.0550093097743131
)
#get prices
prices <-
getSymbols(
Tickers,
src = 'yahoo',
from = "2018-01-01",
to = today(),
auto.assign = TRUE,
warnings = FALSE
) %>%
map(~ Ad(get(.))) %>%
reduce(merge) %>%
`colnames<-`(Tickers)
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
portfolioPrices <- NULL
for (ticker in Tickers) {
portfolioPrices <- cbind(
portfolioPrices,
getSymbols(
ticker,
periodicity = 'daily',
from = "2019-12-31",
to = today() ,
auto.assign = FALSE
)[, 4]
)
}
Port_returns <- ROC(portfolioPrices)
#create Equal Weight Portfolio
Port_equal_weights <-
rep(1 / ncol(Port_returns), ncol(Port_returns))
Port_equal <- Return.portfolio(Port_returns, Port_equal_weights)
## Warning in Return.portfolio(Port_returns, Port_equal_weights): NA's detected:
## filling NA's with zeros
Port_equal <-cumsum(Port_equal)
Portt <- portfolio.spec(names(Port_returns))
#rebalancing Portfolio
Portt <-
add.constraint(Portt,
type = "weight_sum",
min_sum = .98,
max_sum = 1.01)
Portt <- add.constraint(Portt, type = "long_only")
Portt <-
add.constraint(Portt,
type = "box",
min = 0.01,
max = .1)
Portt <- add.objective(Portt, type = "return", name = "mean")
Port_rp <- random_portfolios_v2(Portt, 500000, "sample", TRUE)
nrow(Port_rp)
## [1] 499999
Port_opt_rebal <- optimize.portfolio.rebalancing(
Port_returns,
Portt,
optimize_method = "random",
rp = Port_rp,
rebalance_on = "months",
training_period = 3,
rolling_window = 10
)
Port_RebalanceWeights <- extractWeights(Port_opt_rebal)
Port_rebal_returns <-
Return.portfolio(Port_returns, weights = Port_RebalanceWeights)
## Warning in Return.portfolio(Port_returns, weights = Port_RebalanceWeights): NA's
## detected: filling NA's with zeros
## Warning in Return.portfolio.geometric(R = R, weights = weights, wealth.index =
## wealth.index, : The weights for one or more periods do not sum up to 1: assuming
## a return of 0 for the residual weights
Port_rebal_returns <- cumsum(Port_rebal_returns)
#Current Portfolio
Port_weighted_returns <- Return.portfolio(Port_returns, Weights)
## Warning in Return.portfolio(Port_returns, Weights): NA's detected: filling NA's
## with zeros
Port_weighted_returns <- cumsum(Port_weighted_returns)
#fixing data
names(Port_equal) <- "Equal Weight Portfolio"
names(Port_weighted_returns) <- "Current Portfolio"
names(Port_rebal_returns) <- "Rebalanced Portfolio"
Port_Comps <- cbind(Port_equal, Port_weighted_returns, Port_rebal_returns)
highchart(type = "stock") %>%
hc_add_series(Port_Comps$Equal.Weight.Portfolio, name = "Equal Weight Portfolio") %>%
hc_add_series(Port_Comps$Current.Portfolio, name = "Current Portfolio") %>%
hc_add_series(Port_Comps$Rebalanced.Portfolio, name = "Reblanced Portfolio") %>%
hc_title(text = "Investment Club Analysis") %>%
hc_legend(enabled = TRUE) %>%
hc_add_theme(hc_theme_538())