### 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")