### R code from vignette source 'portfolio_vignette.Rnw'
###################################################
### code chunk number 1: portfolio_vignette.Rnw:59-60
###################################################
library(PortfolioAnalytics)
###################################################
### code chunk number 2: portfolio_vignette.Rnw:65-74
###################################################
data(edhec)
# Use the first 4 columns in edhec for a returns object
returns <- edhec[, 1:4]
colnames(returns) <- c("CA", "CTAG", "DS", "EM")
print(head(returns, 5))
# Get a character vector of the fund names
fund.names <- colnames(returns)
###################################################
### code chunk number 3: portfolio_vignette.Rnw:82-86
###################################################
# Specify a portfolio object by passing a character vector for the
# assets argument.
pspec <- portfolio.spec(assets=fund.names)
print.default(pspec)
###################################################
### code chunk number 4: portfolio_vignette.Rnw:95-100
###################################################
# Add the full investment constraint that specifies the weights must sum to 1.
pspec <- add.constraint(portfolio=pspec,
type="weight_sum",
min_sum=1,
max_sum=1)
###################################################
### code chunk number 5: portfolio_vignette.Rnw:109-119
###################################################
# The full investment constraint can also be specified with type="full_investment"
# pspec <- add.constraint(portfolio=pspec, type="full_investment")
# Another common constraint is that portfolio weights sum to 0.
# This can be specified any of the following ways
# pspec <- add.constraint(portfolio=pspec, type="weight_sum",
# min_sum=0,
# max_sum=0)
# pspec <- add.constraint(portfolio=pspec, type="dollar_neutral")
# pspec <- add.constraint(portfolio=pspec, type="active")
###################################################
### code chunk number 6: portfolio_vignette.Rnw:124-140
###################################################
# Add box constraints
pspec <- add.constraint(portfolio=pspec,
type="box",
min=0.05,
max=0.4)
# min and max can also be specified per asset
# pspec <- add.constraint(portfolio=pspec,
# type="box",
# min=c(0.05, 0, 0.08, 0.1),
# max=c(0.4, 0.3, 0.7, 0.55))
# A special case of box constraints is long only where min=0 and max=1
# The default action is long only if min and max are not specified
# pspec <- add.constraint(portfolio=pspec, type="box")
# pspec <- add.constraint(portfolio=pspec, type="long_only")
###################################################
### code chunk number 7: portfolio_vignette.Rnw:146-152
###################################################
# Add group constraints
pspec <- add.constraint(portfolio=pspec, type="group",
groups=list(groupA=c(1, 2, 3),
grouB=4),
group_min=c(0.1, 0.15),
group_max=c(0.85, 0.55))
###################################################
### code chunk number 8: portfolio_vignette.Rnw:158-163
###################################################
# Add position limit constraint such that we have a maximum number of three assets with non-zero weights.
pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos=3)
# Can also specify maximum number of long positions and short positions
# pspec <- add.constraint(portfolio=pspec, type="position_limit", max_pos_long=3, max_pos_short=3)
###################################################
### code chunk number 9: portfolio_vignette.Rnw:168-169
###################################################
pspec <- add.constraint(portfolio=pspec, type="diversification", div_target=0.7)
###################################################
### code chunk number 10: portfolio_vignette.Rnw:174-175
###################################################
pspec <- add.constraint(portfolio=pspec, type="turnover", turnover_target=0.2)
###################################################
### code chunk number 11: portfolio_vignette.Rnw:180-181
###################################################
pspec <- add.constraint(portfolio=pspec, type="return", return_target=0.007)
###################################################
### code chunk number 12: portfolio_vignette.Rnw:186-189
###################################################
pspec <- add.constraint(portfolio=pspec, type="factor_exposure",
B=c(-0.08, 0.37, 0.79, 1.43),
lower=0.6, upper=0.9)
###################################################
### code chunk number 13: portfolio_vignette.Rnw:194-195
###################################################
pspec <- add.constraint(portfolio=pspec, type="transaction_cost", ptc=0.01)
###################################################
### code chunk number 14: portfolio_vignette.Rnw:199-200
###################################################
print(pspec)
###################################################
### code chunk number 15: portfolio_vignette.Rnw:204-205
###################################################
summary(pspec)
###################################################
### code chunk number 16: portfolio_vignette.Rnw:213-246
###################################################
# full investment constraint
weight_constr <- weight_sum_constraint(min_sum=1, max_sum=1)
# box constraint
box_constr <- box_constraint(assets=pspec$assets, min=0, max=1)
# group constraint
group_constr <- group_constraint(assets=pspec$assets,
groups=list(c(1, 2, 3),
4),
group_min=c(0.1, 0.15),
group_max=c(0.85, 0.55),
group_labels=c("GroupA", "GroupB"))
# position limit constraint
poslimit_constr <- position_limit_constraint(assets=pspec$assets, max_pos=3)
# diversification constraint
div_constr <- diversification_constraint(div_target=0.7)
# turnover constraint
to_constr <- turnover_constraint(turnover_target=0.2)
# target return constraint
ret_constr <- return_constraint(return_target=0.007)
# factor exposure constraint
exp_constr <- factor_exposure_constraint(assets=pspec$assets,
B=c(-0.08, 0.37, 0.79, 1.43),
lower=0.6, upper=0.9)
# transaction cost constraint
ptc_constr <- transaction_cost_constraint(assets=pspec$assets, ptc=0.01)
###################################################
### code chunk number 17: portfolio_vignette.Rnw:255-259
###################################################
pspec <- add.objective(portfolio=pspec,
type='risk',
name='ETL',
arguments=list(p=0.95))
###################################################
### code chunk number 18: portfolio_vignette.Rnw:264-267
###################################################
pspec <- add.objective(portfolio=pspec,
type='return',
name='mean')
###################################################
### code chunk number 19: portfolio_vignette.Rnw:272-278
###################################################
pspec <- add.objective(portfolio=pspec, type="risk_budget", name="ETL",
arguments=list(p=0.95), max_prisk=0.3)
# for an equal risk contribution portfolio, set min_concentration=TRUE
# pspec <- add.objective(portfolio=pspec, type="risk_budget", name="ETL",
# arguments=list(p=0.95), min_concentration=TRUE)
###################################################
### code chunk number 20: portfolio_vignette.Rnw:294-296
###################################################
pspec <- add.objective(portfolio=pspec, type="weight_concentration",
name="HHI", conc_aversion=0.1)
###################################################
### code chunk number 21: portfolio_vignette.Rnw:300-305
###################################################
pspec <- add.objective(portfolio=pspec, type="weight_concentration",
name="HHI",
conc_aversion=c(0.03, 0.06),
conc_groups=list(c(1, 2),
c(3, 4)))
###################################################
### code chunk number 22: portfolio_vignette.Rnw:309-310
###################################################
print(pspec)
###################################################
### code chunk number 23: portfolio_vignette.Rnw:314-315
###################################################
summary(pspec)
###################################################
### code chunk number 24: portfolio_vignette.Rnw:333-365
###################################################
R <- edhec[, 1:4]
# set up simple portfolio with leverage and box constraints
pspec <- portfolio.spec(assets=colnames(R))
pspec <- add.constraint(portfolio=pspec, type="leverage",
min_sum=0.99, max_sum=1.01)
pspec <- add.constraint(portfolio=pspec, type="box", min=0, max=1)
# generate random portfolios using the 3 methods
rp1 <- random_portfolios(portfolio=pspec, permutations=5000,
rp_method='sample')
rp2 <- random_portfolios(portfolio=pspec, permutations=5000,
rp_method='simplex')
rp3 <- random_portfolios(portfolio=pspec, permutations=5000,
rp_method='grid')
# show feasible portfolios in mean-StdDev space
tmp1.mean <- apply(rp1, 1, function(x) mean(R %*% x))
tmp1.StdDev <- apply(rp1, 1, function(x) StdDev(R=R, weights=x))
tmp2.mean <- apply(rp2, 1, function(x) mean(R %*% x))
tmp2.StdDev <- apply(rp2, 1, function(x) StdDev(R=R, weights=x))
tmp3.mean <- apply(rp3, 1, function(x) mean(R %*% x))
tmp3.StdDev <- apply(rp3, 1, function(x) StdDev(R=R, weights=x))
# plot feasible portfolios
plot(x=tmp1.StdDev, y=tmp1.mean, col="gray", main="Random Portfolio Methods",
ylab="mean", xlab="StdDev")
points(x=tmp2.StdDev, y=tmp2.mean, col="red", pch=2)
points(x=tmp3.StdDev, y=tmp3.mean, col="lightgreen", pch=5)
legend("bottomright", legend=c("sample", "simplex", "grid"),
col=c("gray", "red", "lightgreen"),
pch=c(1, 2, 5), bty="n")
###################################################
### code chunk number 25: portfolio_vignette.Rnw:371-381
###################################################
fev <- 0:5
par(mfrow=c(2, 3))
for(i in 1:length(fev)){
rp <- rp_simplex(portfolio=pspec, permutations=2000, fev=fev[i])
tmp.mean <- apply(rp, 1, function(x) mean(R %*% x))
tmp.StdDev <- apply(rp, 1, function(x) StdDev(R=R, weights=x))
plot(x=tmp.StdDev, y=tmp.mean, main=paste("FEV =", fev[i]),
ylab="mean", xlab="StdDev", col=rgb(0, 0, 100, 50, maxColorValue=255))
}
par(mfrow=c(1,1))
###################################################
### code chunk number 26: portfolio_vignette.Rnw:387-403
###################################################
par(mfrow=c(1, 2))
# simplex
rp_simplex <- random_portfolios(portfolio=pspec, permutations=2000,
rp_method='simplex')
tmp.mean <- apply(rp_simplex, 1, function(x) mean(R %*% x))
tmp.StdDev <- apply(rp_simplex, 1, function(x) StdDev(R=R, weights=x))
plot(x=tmp.StdDev, y=tmp.mean, main="rp_method=simplex fev=0:5",
ylab="mean", xlab="StdDev", col=rgb(0, 0, 100, 50, maxColorValue=255))
#sample
rp_sample <- random_portfolios(portfolio=pspec, permutations=2000,
rp_method='sample')
tmp.mean <- apply(rp_sample, 1, function(x) mean(R %*% x))
tmp.StdDev <- apply(rp_sample, 1, function(x) StdDev(R=R, weights=x))
plot(x=tmp.StdDev, y=tmp.mean, main="rp_method=sample",
ylab="mean", xlab="StdDev", col=rgb(0, 0, 100, 50, maxColorValue=255))
par(mfrow=c(1,1))
###################################################
### code chunk number 27: portfolio_vignette.Rnw:429-444
###################################################
library(DEoptim)
library(ROI)
require(ROI.plugin.glpk)
require(ROI.plugin.quadprog)
data(edhec)
R <- edhec[, 1:6]
colnames(R) <- c("CA", "CTAG", "DS", "EM", "EQMN", "ED")
funds <- colnames(R)
# Create an initial portfolio object with leverage and box constraints
init <- portfolio.spec(assets=funds)
init <- add.constraint(portfolio=init, type="leverage",
min_sum=0.99, max_sum=1.01)
init <- add.constraint(portfolio=init, type="box", min=0.05, max=0.65)
###################################################
### code chunk number 28: portfolio_vignette.Rnw:449-450
###################################################
maxret <- add.objective(portfolio=init, type="return", name="mean")
###################################################
### code chunk number 29: portfolio_vignette.Rnw:454-459
###################################################
opt_maxret <- optimize.portfolio(R=R, portfolio=maxret,
optimize_method="ROI",
trace=TRUE)
print(opt_maxret)
###################################################
### code chunk number 30: portfolio_vignette.Rnw:463-466
###################################################
plot(opt_maxret, risk.col="StdDev", return.col="mean",
main="Maximum Return Optimization", chart.assets=TRUE,
xlim=c(0, 0.05), ylim=c(0,0.0085))
###################################################
### code chunk number 31: portfolio_vignette.Rnw:471-472
###################################################
minvar <- add.objective(portfolio=init, type="risk", name="var")
###################################################
### code chunk number 32: portfolio_vignette.Rnw:476-479
###################################################
opt_minvar <- optimize.portfolio(R=R, portfolio=minvar,
optimize_method="ROI", trace=TRUE)
print(opt_minvar)
###################################################
### code chunk number 33: portfolio_vignette.Rnw:483-486
###################################################
plot(opt_minvar, risk.col="StdDev", return.col="mean",
main="Minimum Variance Optimization", chart.assets=TRUE,
xlim=c(0, 0.05), ylim=c(0,0.0085))
###################################################
### code chunk number 34: portfolio_vignette.Rnw:491-493
###################################################
qu <- add.objective(portfolio=init, type="return", name="mean")
qu <- add.objective(portfolio=qu, type="risk", name="var", risk_aversion=0.25)
###################################################
### code chunk number 35: portfolio_vignette.Rnw:497-501
###################################################
opt_qu <- optimize.portfolio(R=R, portfolio=qu,
optimize_method="ROI",
trace=TRUE)
print(opt_qu)
###################################################
### code chunk number 36: portfolio_vignette.Rnw:504-507
###################################################
plot(opt_qu, risk.col="StdDev", return.col="mean",
main="Quadratic Utility Optimization", chart.assets=TRUE,
xlim=c(0, 0.05), ylim=c(0, 0.0085))
###################################################
### code chunk number 37: portfolio_vignette.Rnw:512-513
###################################################
etl <- add.objective(portfolio=init, type="risk", name="ETL")
###################################################
### code chunk number 38: portfolio_vignette.Rnw:517-521
###################################################
opt_etl <- optimize.portfolio(R=R, portfolio=etl,
optimize_method="ROI",
trace=TRUE)
print(opt_etl)
###################################################
### code chunk number 39: portfolio_vignette.Rnw:524-527
###################################################
plot(opt_etl, risk.col="ES", return.col="mean",
main="ETL Optimization", chart.assets=TRUE,
xlim=c(0, 0.14), ylim=c(0,0.0085))
###################################################
### code chunk number 40: portfolio_vignette.Rnw:532-535
###################################################
meanETL <- add.objective(portfolio=init, type="return", name="mean")
meanETL <- add.objective(portfolio=meanETL, type="risk", name="ETL",
arguments=list(p=0.95))
###################################################
### code chunk number 41: portfolio_vignette.Rnw:539-543
###################################################
opt_meanETL <- optimize.portfolio(R=R, portfolio=meanETL,
optimize_method="random",
trace=TRUE, search_size=2000)
print(opt_meanETL)
###################################################
### code chunk number 42: portfolio_vignette.Rnw:547-550
###################################################
stats_meanETL <- extractStats(opt_meanETL)
dim(stats_meanETL)
head(stats_meanETL)
###################################################
### code chunk number 43: portfolio_vignette.Rnw:554-556
###################################################
plot(opt_meanETL, risk.col="ETL", return.col="mean",
main="mean-ETL Optimization", neighbors=25)
###################################################
### code chunk number 44: portfolio_vignette.Rnw:560-563
###################################################
pct_contrib <- ES(R=R, p=0.95, portfolio_method="component",
weights=extractWeights(opt_meanETL))
barplot(pct_contrib$pct_contrib_MES, cex.names=0.8, las=3, col="lightblue")
###################################################
### code chunk number 45: portfolio_vignette.Rnw:570-579
###################################################
# change the box constraints to long only
init$constraints[[2]]$min <- rep(0, 6)
init$constraints[[2]]$max <- rep(1, 6)
rb_meanETL <- add.objective(portfolio=init, type="return", name="mean")
rb_meanETL <- add.objective(portfolio=rb_meanETL, type="risk", name="ETL",
arguments=list(p=0.95))
rb_meanETL <- add.objective(portfolio=rb_meanETL, type="risk_budget",
name="ETL", max_prisk=0.4, arguments=list(p=0.95))
###################################################
### code chunk number 46: portfolio_vignette.Rnw:583-588
###################################################
opt_rb_meanETL <- optimize.portfolio(R=R, portfolio=rb_meanETL,
optimize_method="DEoptim",
search_size=2000,
trace=TRUE, traceDE=5)
print(opt_rb_meanETL)
###################################################
### code chunk number 47: portfolio_vignette.Rnw:591-594
###################################################
plot(opt_rb_meanETL, risk.col="ETL", return.col="mean",
main="Risk Budget mean-ETL Optimization",
xlim=c(0,0.12), ylim=c(0.005,0.009))
###################################################
### code chunk number 48: portfolio_vignette.Rnw:598-600
###################################################
plot.new()
chart.RiskBudget(opt_rb_meanETL, risk.type="percentage", neighbors=25)
###################################################
### code chunk number 49: portfolio_vignette.Rnw:606-612
###################################################
eq_meanETL <- add.objective(portfolio=init, type="return", name="mean")
eq_meanETL <- add.objective(portfolio=eq_meanETL, type="risk", name="ETL",
arguments=list(p=0.95))
eq_meanETL <- add.objective(portfolio=eq_meanETL, type="risk_budget",
name="ETL", min_concentration=TRUE,
arguments=list(p=0.95))
###################################################
### code chunk number 50: portfolio_vignette.Rnw:616-621
###################################################
opt_eq_meanETL <- optimize.portfolio(R=R, portfolio=eq_meanETL,
optimize_method="DEoptim",
search_size=2000,
trace=TRUE, traceDE=5)
print(opt_eq_meanETL)
###################################################
### code chunk number 51: portfolio_vignette.Rnw:625-629
###################################################
plot.new()
plot(opt_eq_meanETL, risk.col="ETL", return.col="mean",
main="Risk Budget mean-ETL Optimization",
xlim=c(0,0.12), ylim=c(0.005,0.009))
###################################################
### code chunk number 52: portfolio_vignette.Rnw:633-635
###################################################
plot.new()
chart.RiskBudget(opt_eq_meanETL, risk.type="percentage", neighbors=25)
###################################################
### code chunk number 53: portfolio_vignette.Rnw:647-654
###################################################
opt_combine <- combine.optimizations(list(meanETL=opt_meanETL,
rbmeanETL=opt_rb_meanETL,
eqmeanETL=opt_eq_meanETL))
# View the weights and objective measures of each optimization
extractWeights(opt_combine)
obj_combine <- extractObjectiveMeasures(opt_combine)
###################################################
### code chunk number 54: portfolio_vignette.Rnw:657-658
###################################################
chart.Weights(opt_combine, plot.type="bar", legend.loc="topleft", ylim=c(0, 1))
###################################################
### code chunk number 55: portfolio_vignette.Rnw:662-666
###################################################
plot.new()
chart.RiskReward(opt_combine, risk.col="ETL", return.col="mean",
main="ETL Optimization Comparison", xlim=c(0.018, 0.024),
ylim=c(0.005, 0.008))
###################################################
### code chunk number 56: portfolio_vignette.Rnw:670-673
###################################################
STARR <- obj_combine[, "mean"] / obj_combine[, "ETL"]
barplot(STARR, col="blue", cex.names=0.8, cex.axis=0.8,
las=3, main="STARR", ylim=c(0,1))
###################################################
### code chunk number 57: portfolio_vignette.Rnw:676-679
###################################################
plot.new()
chart.RiskBudget(opt_combine, match.col="ETL", risk.type="percent",
ylim=c(0,1), legend.loc="topright")