[Returnanalytics-commits] r3379 - pkg/PortfolioAnalytics/sandbox/RFinance2014
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu May 1 07:55:09 CEST 2014
Author: rossbennett34
Date: 2014-05-01 07:55:08 +0200 (Thu, 01 May 2014)
New Revision: 3379
Removed:
pkg/PortfolioAnalytics/sandbox/RFinance2014/R/
pkg/PortfolioAnalytics/sandbox/RFinance2014/data/
pkg/PortfolioAnalytics/sandbox/RFinance2014/data_analysis.R
pkg/PortfolioAnalytics/sandbox/RFinance2014/data_figures/
pkg/PortfolioAnalytics/sandbox/RFinance2014/data_prep.R
pkg/PortfolioAnalytics/sandbox/RFinance2014/edhec.rda
pkg/PortfolioAnalytics/sandbox/RFinance2014/edhec_eda.R
pkg/PortfolioAnalytics/sandbox/RFinance2014/makefile
pkg/PortfolioAnalytics/sandbox/RFinance2014/optimization_analysis.R
pkg/PortfolioAnalytics/sandbox/RFinance2014/optimization_figures/
pkg/PortfolioAnalytics/sandbox/RFinance2014/optimization_results/
pkg/PortfolioAnalytics/sandbox/RFinance2014/optimize.R
pkg/PortfolioAnalytics/sandbox/RFinance2014/presentation.Rmd
pkg/PortfolioAnalytics/sandbox/RFinance2014/presentation.md
pkg/PortfolioAnalytics/sandbox/RFinance2014/slides.pdf
pkg/PortfolioAnalytics/sandbox/RFinance2014/slidy_presentation.html
Log:
Removing files to prep for cleanup and reorganization to presentation directory
Deleted: pkg/PortfolioAnalytics/sandbox/RFinance2014/data_analysis.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/RFinance2014/data_analysis.R 2014-04-28 21:43:21 UTC (rev 3378)
+++ pkg/PortfolioAnalytics/sandbox/RFinance2014/data_analysis.R 2014-05-01 05:55:08 UTC (rev 3379)
@@ -1,45 +0,0 @@
-library(PerformanceAnalytics)
-
-source("data_prep.R")
-
-##### Equity Data for Example 1 and Example 2 #####
-colors <- c(rep("blue", 15), rep("green", 15), rep("red", 5))
-sd.order <- order(StdDev(equity.data))
-
-# boxplot to compare return distributions
-# mar(bottom, left, top, right)
-# default: par(mar=c(5, 4, 4, 2) + 0.1)
-png("data_figures/equity_box.png")
-boxplot(coredata(equity.data[,sd.order]),
- cex.axis=0.8, las=3, ylab="Returns", pch=18,
- col=colors[sd.order],
- main="Return Distribution\n(sorted by StdDev)")
-legend("topleft", legend=c("Large Cap", "Mid Cap", "Small Cap"),
- fill=c("blue", "green", "red"), bty="n", cex=0.8)
-dev.off()
-
-##### edhec Data for Example 3 and Example 4 #####
-p <- 0.95
-
-png("data_figures/relative_barvar.png")
-charts.BarVaR(R[,1:3], width=60, methods=c("ModifiedES", "ModifiedVaR"),
- main="Relative Value")
-dev.off()
-
-png("data_figures/directional_barvar.png")
-charts.BarVaR(R[,4:6], width=60, methods=c("ModifiedES", "ModifiedVaR"),
- main="Directional")
-dev.off()
-
-
-colors <- c(rep("lightblue", 3), rep("red", 3))
-ES.order <- order(ES(R, p=p, invert=FALSE))
-
-png("data_figures/edhec_box.png")
-boxplot(coredata(R[,ES.order]),
- cex.axis=0.8, las=3, ylab="Returns", pch=18,
- col=colors[ES.order],
- main="Return Distribution\n(sorted by Modified ES (95%))")
-legend("topleft", legend=c("Relative Value", "Directional"),
- fill=c("lightblue", "red"), bty="n", cex=0.8)
-dev.off()
Deleted: pkg/PortfolioAnalytics/sandbox/RFinance2014/data_prep.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/RFinance2014/data_prep.R 2014-04-28 21:43:21 UTC (rev 3378)
+++ pkg/PortfolioAnalytics/sandbox/RFinance2014/data_prep.R 2014-05-01 05:55:08 UTC (rev 3379)
@@ -1,25 +0,0 @@
-
-##### Equity Data for Example 1 and Example 2 #####
-load("data/crsp_weekly.rda")
-
-equity.data <- cbind(largecap_weekly[,1:15],
- midcap_weekly[,1:15],
- smallcap_weekly[,1:5])
-market <- largecap_weekly[,21]
-Rf <- largecap_weekly[,22]
-
-##### edhec Data for Example 3 and Example 4 #####
-# Load the updated edhec dataset
-load("data/edhec.rda")
-
-# Prep data for Examples 3 and 4
-R <- edhec[,c("Convertible.Arbitrage", "Equity.Market.Neutral",
- "Fixed.Income.Arbitrage",
- "CTA.Global", "Emerging.Markets", "Global.Macro")]
-# Abreviate column names for convenience and plotting
-colnames(R) <- c("CA", "EMN", "FIA", "CTAG", "EM", "GM")
-
-
-# clean up and remove the data we don't need
-rm(largecap_weekly, midcap_weekly, smallcap_weekly, microcap_weekly)
-rm(edhec)
Deleted: pkg/PortfolioAnalytics/sandbox/RFinance2014/edhec.rda
===================================================================
(Binary files differ)
Deleted: pkg/PortfolioAnalytics/sandbox/RFinance2014/edhec_eda.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/RFinance2014/edhec_eda.R 2014-04-28 21:43:21 UTC (rev 3378)
+++ pkg/PortfolioAnalytics/sandbox/RFinance2014/edhec_eda.R 2014-05-01 05:55:08 UTC (rev 3379)
@@ -1,78 +0,0 @@
-# script for data analysis
-
-library(PerformanceAnalytics)
-library(lattice)
-library(corrplot)
-
-load("data/edhec.rda")
-
-head(edhec)
-R <- edhec[,1:4]
-p <- 0.95
-
-first(R)
-last(R)
-
-# plot the timeseries of returns
-# plot(as.zoo(edhec))
-xyplot(R, scales=list(y="same"))
-charts.BarVaR(R, width=36, methods=c("ModifiedES", "ModifiedVaR"))
-dev.off()
-
-# boxplot to compare return distributions
-# mar(bottom, left, top, right)
-# default: par(mar=c(5, 4, 4, 2) + 0.1)
-par(mar=c(10, 4, 4, 2) + 0.1)
-boxplot(coredata(R[,order(ES(R, p=p, invert=FALSE))]),
- cex.axis=0.8, las=3, ylab="Returns", pch=18,
- main="Return Distribution\n(sorted by Modified ES (95%))")
-par(mar=c(5, 4, 4, 2) + 0.1)
-dev.off()
-
-# head(R[,order(ES(R, invert=FALSE))])
-# head(R[,order(StdDev(R))])
-# chart.Boxplot(R[,order(ES(R, invert=FALSE))])
-# chart.Boxplot(R[,order(StdDev(R))])
-# boxplot(coredata(R), col=c(2:5), cex.names=0.8, las=3)
-
-# chart the distribution of returns
-for(i in 1:ncol(R)){
- chart.Histogram(R[,i], methods=c("add.density", "add.normal"),
- colorset=c("lightgray", "black", "blue"))
- legend("topleft", legend=c("kernel density estimate", "normal"),
- lty=c(1,1), col=c("black", "blue"), bty="n")
- Sys.sleep(1)
-}
-
-
-# chart the correlation and covariance
-# from http://cran.r-project.org/web/packages/corrplot/vignettes/corrplot-intro.html
-cor.mtest <- function(mat, conf.level = 0.95) {
- mat <- as.matrix(mat)
- n <- ncol(mat)
- p.mat <- lowCI.mat <- uppCI.mat <- matrix(NA, n, n)
- diag(p.mat) <- 0
- diag(lowCI.mat) <- diag(uppCI.mat) <- 1
- for (i in 1:(n - 1)) {
- for (j in (i + 1):n) {
- tmp <- cor.test(mat[, i], mat[, j], conf.level = conf.level)
- p.mat[i, j] <- p.mat[j, i] <- tmp$p.value
- lowCI.mat[i, j] <- lowCI.mat[j, i] <- tmp$conf.int[1]
- uppCI.mat[i, j] <- uppCI.mat[j, i] <- tmp$conf.int[2]
- }
- }
- return(list(p.mat, lowCI.mat, uppCI.mat))
-}
-res <- cor.mtest(R)
-
-corrplot(cor(R), p.mat=res[[1]], main="Correlation",
- sig.level=0.05, tl.cex=0.8)
-
-# corrplot(M, method="number", bg="gray", tl.cex=0.8)
-# corrplot.mixed(M, bg="gray", tl.cex=0.8)
-
-# If I compare sample min variance portfolio to a ledoit-shrinkage or robust,
-# I should use plotcov to compare covaiance matrices
-
-
-
Deleted: pkg/PortfolioAnalytics/sandbox/RFinance2014/makefile
===================================================================
--- pkg/PortfolioAnalytics/sandbox/RFinance2014/makefile 2014-04-28 21:43:21 UTC (rev 3378)
+++ pkg/PortfolioAnalytics/sandbox/RFinance2014/makefile 2014-05-01 05:55:08 UTC (rev 3379)
@@ -1,63 +0,0 @@
-# http://robjhyndman.com/hyndsight/makefiles/
-# https://www.cs.umd.edu/class/fall2002/cmsc214/Tutorial/makefile.html
-
-# List the R files used
-RFILES := data_prep.R data_analysis.R optimize.R optimization_analysis.R
-
-# Rout indicator files to show R file has run
-# R CMD BATCH will generate .Rout files after running
-OUT_FILES:= $(RFILES:.R=.Rout)
-
-
-all: $(OUT_FILES) slidy_presentation.html presentation.Rmd
-
-# Generate slidy presentation from markdown file
-slidy_presentation.html: $(RFILES) $(OUT_FILES) presentation.md
- pandoc -t slidy -s --mathjax presentation.md -o slidy_presentation.html
-
-# Generate slidy presentation from markdown file
-slides.pdf: $(RFILES) $(OUT_FILES) presentation.md
- pandoc -t -S beamer —-slide-level 2 presentation.md -o slides.pdf
-
-# Generate markdown file from R markdown file
-presentation.md: presentation.Rmd
- Rscript -e "library(knitr); knit('presentation.Rmd')"
-
-# Data analysis script
-data_analysis.Rout: data_analysis.R
- R CMD BATCH --vanilla data_analysis.R
-
-# Optimization analysis script to analyze results of optimization
-optimization_analysis.Rout: optimization_analysis.R optimize.R
- R CMD BATCH --vanilla optimization_analysis.R
-
-# Run optimizations
-optimize.Rout: optimize.R
- R CMD BATCH --vanilla optimize.R
-
-# Data prep
-data_prep.Rout: data_prep.R
- R CMD BATCH --vanilla data_prep.R
-
-lwShrink.Rout: R/lwShrink.R
- R CMD BATCH --vanilla R/lwShrink.R
-
-charting.Rout: R/charting.R
- R CMD BATCH --vanilla R/charting.R
-
-# Use Rscript to run the necessary R files as an alternative to R CMD BATCH
-runR:
- Rscript data_prep.R
- Rscript data_analysis.R
- Rscript optimize.R
- Rscript optimization_analysis.R
-
-clean:
- rm -f *.Rout
- rm -f data_figures/*.png
- rm -f optimization_figures/*.png
- rm -f optimization_results/*.rda
- rm -f *.md
- rm -f *.html
- rm -f cache/*
-
\ No newline at end of file
Deleted: pkg/PortfolioAnalytics/sandbox/RFinance2014/optimization_analysis.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/RFinance2014/optimization_analysis.R 2014-04-28 21:43:21 UTC (rev 3378)
+++ pkg/PortfolioAnalytics/sandbox/RFinance2014/optimization_analysis.R 2014-05-01 05:55:08 UTC (rev 3379)
@@ -1,199 +0,0 @@
-library(PortfolioAnalytics)
-library(methods)
-
-source("R/charting.R")
-
-# Set the directory where the optimization results are saved
-results.dir <- "optimization_results"
-figures.dir <- "optimization_figures"
-
-
-##### Example 1 #####
-load(paste(results.dir, "opt.minVarSample.rda", sep="/"))
-load(paste(results.dir, "opt.minVarLW.rda", sep="/"))
-
-# Chart the weights through time
-png(paste(figures.dir, "weights_minVarSample.png", sep="/"))
-chart.Weights(opt.minVarSample, main="minVarSample Weights", legend.loc=NULL)
-dev.off()
-
-w1 <- nvd3WeightsPlot(opt.minVarSample)
-save(w1, file=paste(figures.dir, "w1.rda", sep="/"))
-
-
-png(paste(figures.dir, "weights_minVarLW.png", sep="/"))
-chart.Weights(opt.minVarLW, main="minVarLW Weights", legend.loc=NULL)
-dev.off()
-
-w2 <- nvd3WeightsPlot(opt.minVarLW)
-save(w2, file=paste(figures.dir, "w2.rda", sep="/"))
-
-# Compute the returns and chart the performance summary
-ret.minVarSample <- summary(opt.minVarSample)$portfolio_returns
-ret.minVarRobust <- summary(opt.minVarLW)$portfolio_returns
-ret.minVar <- cbind(ret.minVarSample, ret.minVarRobust)
-colnames(ret.minVar) <- c("Sample", "LW")
-
-png(paste(figures.dir, "ret_minVar.png", sep="/"))
-charts.PerformanceSummary(ret.minVar)
-dev.off()
-
-##### Example 2 #####
-load(paste(results.dir, "opt.dn.rda", sep="/"))
-
-png(paste(figures.dir, "opt_dn.png", sep="/"))
-plot(opt.dn, main="Dollar Neutral Portfolio", risk.col="StdDev", neighbors=10)
-dev.off()
-
-
-# chart.RiskReward(opt, risk.col="StdDev", neighbors=25)
-# chart.Weights(opt, plot.type="bar", legend.loc=NULL)
-# wts <- extractWeights(opt)
-# t(wts) %*% betas
-# sum(abs(wts))
-# sum(wts[wts > 0])
-# sum(wts[wts < 0])
-# sum(wts != 0)
-
-##### Example 3 #####
-load(file=paste(results.dir, "opt.minES.rda", sep="/"))
-load(file=paste(results.dir, "bt.opt.minES.rda", sep="/"))
-
-# ES(R, portfolio_method="component", weights=extractWeights(opt.minES[[1]]))
-# extractObjectiveMeasures(opt.minES)
-
-# extract objective measures, out, and weights
-xtract <- extractStats(opt.minES)
-
-# get the 'mean' and 'ES' columns from each element of the list
-xtract.mean <- unlist(lapply(xtract, function(x) x[,"mean"]))
-xtract.ES <- unlist(lapply(xtract, function(x) x[,"ES"]))
-
-
-png(paste(figures.dir, "opt_minES.png", sep="/"))
-# plot the feasible space
-par(mar=c(7,4,4,1)+0.1)
-plot(xtract.ES, xtract.mean, col="gray",
- main="Minimum ES Portfolios",
- xlab="ES", ylab="Mean",
- ylim=c(0.005, 0.007),
- xlim=c(0.015, 0.085))
-
-# min ES
-points(x=opt.minES[[1]]$objective_measures$ES$MES,
- y=opt.minES[[1]]$objective_measures$mean,
- pch=15, col="purple")
-text(x=opt.minES[[1]]$objective_measures$ES$MES,
- y=opt.minES[[1]]$objective_measures$mean,
- labels="Min ES", pos=1, col="purple", cex=0.8)
-
-# min ES with risk budget upper limit on component contribution to risk
-points(x=opt.minES[[2]]$objective_measures$ES$MES,
- y=opt.minES[[2]]$objective_measures$mean,
- pch=15, col="black")
-text(x=opt.minES[[2]]$objective_measures$ES$MES,
- y=opt.minES[[2]]$objective_measures$mean,
- labels="Min ES RB", pos=4, col="black", cex=0.8)
-
-# min ES with equal (i.e. min concentration) component contribution to risk
-points(x=opt.minES[[3]]$objective_measures$ES$MES,
- y=opt.minES[[3]]$objective_measures$mean,
- pch=15, col="darkgreen")
-text(x=opt.minES[[3]]$objective_measures$ES$MES,
- y=opt.minES[[3]]$objective_measures$mean,
- labels="Min ES EqRB", pos=4, col="darkgreen", cex=0.8)
-par(mar=c(5,4,4,1)+0.1)
-dev.off()
-
-# Chart the risk contribution
-#chart.RiskBudget(opt.minES[[1]], risk.type="percentage", neighbors=10)
-png(paste(figures.dir, "rb_minES.png", sep="/"))
-chart.RiskBudget(opt.minES[[2]], main="Risk Budget Limit",
- risk.type="percentage", neighbors=10)
-dev.off()
-
-png(paste(figures.dir, "eqrb_minES.png", sep="/"))
-chart.RiskBudget(opt.minES[[3]], main="Equal ES Component Contribution",
- risk.type="percentage", neighbors=10)
-dev.off()
-
-# Plot the risk contribution of portfolio 1 through time
-png(paste(figures.dir, "risk_minES.png", sep="/"))
-chart.RiskBudget(bt.opt.minES[[1]], main="Min ES Risk Contribution",
- risk.type="percentage")
-dev.off()
-# Plot the risk contribution of portfolio 1 through time
-png(paste(figures.dir, "weights_minES.png", sep="/"))
-chart.Weights(bt.opt.minES[[1]], main="Min ES Weights")
-dev.off()
-
-# Plot the risk contribution of portfolio 3 through time
-png(paste(figures.dir, "risk_minESRB.png", sep="/"))
-chart.RiskBudget(bt.opt.minES[[2]], main="Min ES RB Risk Contribution",
- risk.type="percentage")
-dev.off()
-# Plot the weights of portfolio 2 through time
-png(paste(figures.dir, "weights_minESRB.png", sep="/"))
-chart.Weights(bt.opt.minES[[2]], main="Min ES RB Weights")
-dev.off()
-
-# Plot the risk contribution of portfolio 3 through time
-png(paste(figures.dir, "risk_minESEqRB.png", sep="/"))
-chart.RiskBudget(bt.opt.minES[[3]], main="Min ES EqRB Risk Contribution",
- risk.type="percentage")
-dev.off()
-# Plot the weights of portfolio 3 through time
-png(paste(figures.dir, "weights_minESEqRB.png", sep="/"))
-chart.Weights(bt.opt.minES[[3]], main="Min ES EqRB Weights")
-dev.off()
-
-# Extract the returns from each element and chart the performance summary
-ret.bt.opt <- do.call(cbind, lapply(bt.opt.minES,
- function(x) summary(x)$portfolio_returns))
-colnames(ret.bt.opt) <- c("min ES", "min ES RB", "min ES Eq RB")
-
-png(paste(figures.dir, "ret_minES.png", sep="/"))
-charts.PerformanceSummary(ret.bt.opt)
-dev.off()
-
-###
-# interactive plot of risk budgets through time using nvd3
-# nvd3RiskPlot(bt.opt.minES[[1]])
-# nvd3RiskPlot(bt.opt.minES[[2]])
-# nvd3RiskPlot(bt.opt.minES[[3]])
-###
-
-##### Example 4 #####
-load(file=paste(results.dir, "opt.crra.rda", sep="/"))
-load(file=paste(results.dir, "bt.opt.crra.rda", sep="/"))
-
-CRRA <- function(R, weights, lambda, sigma, m3, m4){
- weights <- matrix(weights, ncol=1)
- M2.w <- t(weights) %*% sigma %*% weights
- M3.w <- t(weights) %*% m3 %*% (weights %x% weights)
- M4.w <- t(weights) %*% m4 %*% (weights %x% weights %x% weights)
- term1 <- 0.5 * lambda * M2.w
- term2 <- (1 / 6) * lambda * (lambda + 1) * M3.w
- term3 <- (1 / 24) * lambda * (lambda + 1) * (lambda + 2) * M4.w
- out <- -term1 + term2 - term3
- out
-}
-
-# Chart the optimization in Risk-Reward space
-png(paste(figures.dir, "crra_RR_ES.png", sep="/"))
-chart.RiskReward(opt.crra, risk.col="ES")
-# dev.off()
-
-png(paste(figures.dir, "crra_RR_StdDev.png", sep="/"))
-chart.RiskReward(opt.crra, risk.col="StdDev")
-dev.off()
-
-# Compute the portfolio returns with rebalancing
-ret.crra <- summary(bt.opt.crra)$portfolio_returns
-colnames(ret.crra) <- "CRRA"
-
-# Plot the performance summary of the returns from example 3 and CRRA
-png(paste(figures.dir, "ret_crra.png", sep="/"))
-charts.PerformanceSummary(cbind(ret.bt.opt, ret.crra), main="Optimization Performance")
-dev.off()
-
Deleted: pkg/PortfolioAnalytics/sandbox/RFinance2014/optimize.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/RFinance2014/optimize.R 2014-04-28 21:43:21 UTC (rev 3378)
+++ pkg/PortfolioAnalytics/sandbox/RFinance2014/optimize.R 2014-05-01 05:55:08 UTC (rev 3379)
@@ -1,449 +0,0 @@
-# script used to run the portfolio optimizations
-
-# Examples to consider
-# Example 1: Consider a portfolio of stocks. Full investment and long
-# only (or box) constraints. Objective to minimize portfolio variance.
-# Demonstrate a custom moments function to compare a sample covariance
-# matrix estimate and a robust covariance matrix estimate. An alternative
-# to a MCD estimate is ledoit-wolf shrinkage, DCC GARCH model,
-# factor model, etc.
-
-# Example 2: Consider a portfolio of stocks. Dollar neutral, beta
-# neutral, box constraints, and leverage_exposure constraints. Objective
-# to minimize portfolio StdDev. This will demonstrate some of the
-# more advanced constraint types. Could also introduce position limit
-# constraints here in this example.
-
-# Example 3: Consider an allocation to hedge funds using the
-# EDHEC-Risk Alternative Index as a proxy. This will be an extended
-# example starting with an objective to minimize portfolio expected
-# shortfall, then risk budget percent contribution limit, then equal
-# risk contribution limit.
-
-# Example 4: Consider an allocation to hedge funds using the
-# EDHEC-Risk Alternative Index as a proxy.
-
-# Option 1 for example 4
-# Objective to maximize a risk adjusted return measure
-# (e.g.Calmar Ratio, Sterling Ratio, Sortino Ratio, or Upside Potential
-# Ratio)
-
-# I prefer doing this option
-# Option 2 for example 4
-# Objective to maximize the
-# fourth order expansion of the Constant Relative Risk Aversion (CRRA)
-# expected utility function. Demonstrate a custom moment function and
-# a custom objective function.
-
-# Set the directory to save the optimization results
-results.dir <- "optimization_results"
-
-# Load the packages
-library(PortfolioAnalytics)
-library(foreach)
-library(ROI)
-library(ROI.plugin.quadprog)
-
-# for running via Rscript
-library(methods)
-
-# Source in the lwShrink function
-source("R/lwShrink.R")
-
-# Example 1 and Example 2 will use the crsp_weekly data
-# Example 3 and Example 4 will use the edhec data
-source("data_prep.R")
-
-
-##### Example 1 #####
-stocks <- colnames(equity.data)
-# Specify an initial portfolio
-portf.init <- portfolio.spec(stocks)
-# Add constraints
-# weights sum to 1
-portf.minvar <- add.constraint(portf.init, type="full_investment")
-# box constraints
-portf.minvar <- add.constraint(portf.minvar, type="box", min=0.01, max=0.45)
-
-# Add objective
-# objective to minimize portfolio variance
-portf.minvar <- add.objective(portf.minvar, type="risk", name="var")
-
-# Backtesting parameters
-# Set rebalancing frequency
-rebal.freq <- "quarters"
-# Training Period
-training <- 400
-# Trailing Period
-trailing <- 250
-
-# Run optimization
-# Sample Covariance Matrix Estimate
-
-# By default, momentFUN uses set.portfolio.moments which computes the sample
-# moment estimates
-
-cat("Example 1: running minimum variance with sample covariance matrix
- estimate backtest\n")
-if(file.exists(paste(results.dir, "opt.minVarSample.rda", sep="/"))){
- cat("file already exists\n")
-} else {
- opt.minVarSample <- optimize.portfolio.rebalancing(equity.data, portf.minvar,
- optimize_method="ROI",
- rebalance_on=rebal.freq,
- training_period=training,
- trailing_periods=trailing)
- cat("opt.minVarSample complete. Saving results to ", results.dir, "\n")
- save(opt.minVarSample, file=paste(results.dir, "opt.minVarSample.rda", sep="/"))
-}
-
-# Custom moment function to use Ledoit-Wolf shinkage covariance matrix estimate
-lw.sigma <- function(R, ...){
- out <- list()
- # estimate covariance matrix via robust covariance matrix estimate,
- # ledoit-wolf shrinkage, GARCH, factor model, etc.
- # set.seed(1234)
- # out$sigma <- MASS::cov.rob(R, method="mcd", ...)$cov
- out$sigma <- lwShrink(R)$cov
- #print(index(last(R)))
- return(out)
-}
-
-cat("Example 1: running minimum variance with Ledoit-Wolf shrinkage covariance
- matrix estimate backtest\n")
-if(file.exists(paste(results.dir, "opt.minVarLW.rda", sep="/"))){
- cat("file already exists\n")
-} else{
- # Using Ledoit-Wolf Shrinkage Covariance Matrix Estimate
- opt.minVarLW <- optimize.portfolio.rebalancing(equity.data, portf.minvar,
- optimize_method="ROI",
- momentFUN=lw.sigma,
- rebalance_on=rebal.freq,
- training_period=training,
- trailing_periods=trailing)
- cat("opt.minVarLW complete. Saving results to ", results.dir, "\n")
- save(opt.minVarLW, file=paste(results.dir, "opt.minVarLW.rda", sep="/"))
-}
-
-##### Example 2 #####
-portf.init <- portfolio.spec(stocks)
-
-# weights sum to 0
-portf.dn <- add.constraint(portf.init, type="weight_sum",
- min_sum=-0.01, max_sum=0.01)
-
-# Add box constraints such that no stock has weight less than -20% or
-# greater than 20%
-portf.dn <- add.constraint(portf.dn, type="box",
- min=-0.2, max=0.2)
-# Add position limit constraint such that the portfolio has a maximum
-# of 20 non-zero positions
-portf.dn <- add.constraint(portf.dn, type="position_limit", max_pos=20)
-
-# Compute the betas of each stock
-betas <- t(CAPM.beta(equity.data, market, Rf))
-
-# Add factor exposure constraint to limit portfolio beta
-portf.dn <- add.constraint(portf.dn, type="factor_exposure", B=betas,
- lower=-0.25, upper=0.25)
-# portf.dn <- add.constraint(portf.dn, type="leverage_exposure", leverage=2)
-
-# generate random portfolios
-if(file.exists(paste(results.dir, "rp.rda", sep="/"))){
- cat("random portfolios already generated\n")
-} else {
- cat("generating random portfolios\n")
- rp <- random_portfolios(portf.dn, 10000, eliminate=TRUE)
- cat("random portfolios generated. Saving rp to ", results.dir, "\n")
- save(rp, file=paste(results.dir, "rp.rda", sep="/"))
-}
-
-# Add objective to maximize return
-portf.dn.StdDev <- add.objective(portf.dn, type="return", name="mean",
- target=0.0015)
-# Add objective to target a portfolio standard deviation of 2%
-portf.dn.StdDev <- add.objective(portf.dn.StdDev, type="risk", name="StdDev",
- target=0.02)
-
-cat("Example 2: running dollar neutral optimization\n")
-if(file.exists(paste(results.dir, "opt.dn.rda", sep="/"))){
- cat("file already exists\n")
-} else {
- # Run optimization
- opt.dn <- optimize.portfolio(equity.data, portf.dn.StdDev,
- optimize_method="random", rp=rp,
- trace=TRUE)
- cat("opt.dn complete. Saving results to ", results.dir, "\n")
- save(opt.dn, file=paste(results.dir, "opt.dn.rda", sep="/"))
-}
-
-##### Example 3 #####
-# Example 3 will consider three portfolios
-# - minES
-# - minES with component contribution limit
-# - minES with equal risk contribution
-
-funds <- colnames(R)
-portf.init <- portfolio.spec(funds)
-portf.init <- add.constraint(portf.init, type="weight_sum",
- min_sum=0.99, max_sum=1.01)
-
-portf.init <- add.constraint(portf.init, type="box",
- min=0.05, max=0.4)
-
-# Set multiplier=0 so that it is calculated, but does not affect the optimization
-portf.init <- add.objective(portf.init, type="return",
- name="mean", multiplier=0)
-
-# Add objective to minimize expected shortfall
-portf.minES <- add.objective(portf.init, type="risk", name="ES")
-
-# Add risk budget objective with upper limit on percentage contribution
-portf.minES.RB <- add.objective(portf.minES, type="risk_budget",
- name="ES", max_prisk=0.3)
-
-# Relax the box constraint
-portf.minES.RB$constraints[[2]]$max <- rep(1,ncol(R))
-# print.default(portf.minES.RB$constraints[[2]])
-
-# Add risk budget objective to minimize concentration of percentage component
-# contribution to risk. Concentration is defined as the Herfindahl-Hirschman
-# Index (HHI). $\sum_i x_i^2$
-portf.minES.EqRB <- add.objective(portf.minES, type="risk_budget",
- name="ES", min_concentration=TRUE)
-# relax the box constraint
-portf.minES.EqRB <- add.constraint(portf.minES.EqRB, type="box",
- min=0.05, max=1, indexnum=2)
-# portf.minES.RB$constraints[[2]]$max <- rep(1,ncol(R))
-# print.default(portf.minES.EqRB$constraints[[2]])
-
-# Add risk budget objective to minES portfolio with multiplier=0 so that it
-# is calculated, but does not affect optimization
-portf.minES <- add.objective(portf.minES, type="risk_budget",
- name="ES", multiplier=0)
-
-# Combine the portfolios so we can make a single call to
-# optimize.portfolio
-portf <- combine.portfolios(list(minES=portf.minES,
- minES.RB=portf.minES.RB,
- minES.EqRB=portf.minES.EqRB))
-
-cat("Example 3: running minimum ES optimizations\n")
-if(file.exists(paste(results.dir, "opt.minES.rda", sep="/"))){
- cat("file already exists\n")
-} else {
- # Run the optimization
- opt.minES <- optimize.portfolio(R, portf, optimize_method="DEoptim",
- search_size=5000, trace=TRUE, traceDE=0,
- message=TRUE)
- cat("opt.minES complete. Saving results to ", results.dir, "\n")
- save(opt.minES, file=paste(results.dir, "opt.minES.rda", sep="/"))
-}
-
-# Now we want to evaluate the optimization through time
-
-# Rebalancing parameters
-# Set rebalancing frequency
-rebal.freq <- "quarters"
-# Training Period
-training <- 120
-# Trailing Period
-trailing <- 72
-
-cat("Example 3: running minimum ES backtests\n")
-if(file.exists(paste(results.dir, "bt.opt.minES.rda", sep="/"))){
- cat("file already exists\n")
-} else {
- # Backtest
- bt.opt.minES <- optimize.portfolio.rebalancing(R, portf,
- optimize_method="DEoptim",
- rebalance_on=rebal.freq,
- training_period=training,
- trailing_periods=trailing,
- search_size=5000,
- traceDE=0, message=TRUE)
- cat("bt.opt.minES complete. Saving results to ", results.dir, "\n")
- save(bt.opt.minES, file=paste(results.dir, "bt.opt.minES.rda", sep="/"))
-}
-
-##### Example 4 #####
-
-# Simple function to compute the moments used in CRRA
-crra.moments <- function(R, ...){
- out <- list()
- out$mu <- colMeans(R)
- out$sigma <- cov(R)
- out$m3 <- PerformanceAnalytics:::M3.MM(R)
- out$m4 <- PerformanceAnalytics:::M4.MM(R)
- out
-}
-
-
-# Fourth order expansion of CRRA expected utility
-CRRA <- function(R, weights, lambda, sigma, m3, m4){
- weights <- matrix(weights, ncol=1)
- M2.w <- t(weights) %*% sigma %*% weights
- M3.w <- t(weights) %*% m3 %*% (weights %x% weights)
- M4.w <- t(weights) %*% m4 %*% (weights %x% weights %x% weights)
- term1 <- 0.5 * lambda * M2.w
- term2 <- (1 / 6) * lambda * (lambda + 1) * M3.w
- term3 <- (1 / 24) * lambda * (lambda + 1) * (lambda + 2) * M4.w
- out <- -term1 + term2 - term3
- out
-}
-
-# test the CRRA function
-portf.crra <- portfolio.spec(funds)
-portf.crra <- add.constraint(portf.crra, type="weight_sum",
- min_sum=0.99, max_sum=1.01)
-
-portf.crra <- add.constraint(portf.crra, type="box",
- min=0.05, max=0.4)
-
-portf.crra <- add.objective(portf.crra, type="return",
- name="CRRA", arguments=list(lambda=10))
-
-# I just want these for plotting
-# Set multiplier=0 so that it is calculated, but does not affect the optimization
-portf.crra <- add.objective(portf.crra, type="return", name="mean", multiplier=0)
-portf.crra <- add.objective(portf.crra, type="risk", name="ES", multiplier=0)
-portf.crra <- add.objective(portf.crra, type="risk", name="StdDev", multiplier=0)
-
-cat("Example 4: running maximum CRRA optimization\n")
-if(file.exists(paste(results.dir, "opt.crra.rda", sep="/"))){
- cat("file already exists\n")
-} else {
- # Run the optimization
- opt.crra <- optimize.portfolio(R, portf.crra, optimize_method="DEoptim",
- search_size=5000, trace=TRUE, traceDE=0,
- momentFUN="crra.moments")
- cat("opt.crra complete. Saving results to ", results.dir, "\n")
- save(opt.crra, file=paste(results.dir, "opt.crra.rda", sep="/"))
-}
-
-cat("Example 4: running maximum CRRA backtest\n")
-if(file.exists(paste(results.dir, "bt.opt.crra.rda", sep="/"))){
- cat("file already exists\n")
-} else {
- # Run the optimization with rebalancing
- bt.opt.crra <- optimize.portfolio.rebalancing(R, portf.crra,
- optimize_method="DEoptim",
- search_size=5000, trace=TRUE,
- traceDE=0,
- momentFUN="crra.moments",
- rebalance_on=rebal.freq,
- training_period=training,
- trailing_periods=trailing)
- cat("bt.opt.crra complete. Saving results to ", results.dir, "\n")
- save(bt.opt.crra, file=paste(results.dir, "bt.opt.crra.rda", sep="/"))
-}
-
-##### RP Demo #####
-cat("Random portfolio method comparison\n")
-if(file.exists("optimization_figures/rp_plot.png")){
- cat("file already exists\n")
-} else {
- portf.lo <- portfolio.spec(colnames(R))
- portf.lo <- add.constraint(portf.lo, type="weight_sum",
- min_sum=0.99, max_sum=1.01)
-
- portf.lo <- add.constraint(portf.lo, type="long_only")
-
- # Use the long only portfolio previously created
- # Generate random portfolios using the 3 methods
- rp1 <- random_portfolios(portf.lo, permutations=5000,
- rp_method='sample')
- rp2 <- random_portfolios(portf.lo, permutations=5000,
- rp_method='simplex')
- rp3 <- random_portfolios(portf.lo, permutations=5000,
- rp_method='grid')
-
- # Calculate the portfolio mean return and standard deviation
- rp1_mean <- apply(rp1, 1, function(x) mean(R %*% x))
- rp1_StdDev <- apply(rp1, 1, function(x) StdDev(R, weights=x))
- rp2_mean <- apply(rp2, 1, function(x) mean(R %*% x))
- rp2_StdDev <- apply(rp2, 1, function(x) StdDev(R, weights=x))
- rp3_mean <- apply(rp3, 1, function(x) mean(R %*% x))
- rp3_StdDev <- apply(rp3, 1, function(x) StdDev(R, weights=x))
-
- x.assets <- StdDev(R)
- y.assets <- colMeans(R)
- ###
- # create an interactive plot using rCharts and nvd3 scatterChart
- # tmp1 <- data.frame(name="sample", mean=rp1_mean, sd=rp1_StdDev)
- # tmp2 <- data.frame(name="simplex", mean=rp2_mean, sd=rp2_StdDev)
- # tmp3 <- data.frame(name="grid", mean=rp3_mean, sd=rp3_StdDev)
- # tmp <- rbind(tmp1, tmp2, tmp3)
- # n1 <- nPlot(mean ~ sd, group="name", data=tmp, type="scatterChart")
- # n1
- ###
- x.lower <- min(x.assets) * 0.9
- x.upper <- max(x.assets) * 1.1
- y.lower <- min(y.assets) * 0.9
- y.upper <- max(y.assets) * 1.1
-
- png("optimization_figures/rp_plot.png")
- # plot feasible portfolios
- plot(x=rp1_StdDev, y=rp1_mean, col="gray", main="Random Portfolio Methods",
- ylab="mean", xlab="StdDev", xlim=c(x.lower, x.upper),
- ylim=c(y.lower, y.upper))
- points(x=rp2_StdDev, y=rp2_mean, col="red", pch=2)
- points(x=rp3_StdDev, y=rp3_mean, col="green", pch=5)
- points(x=x.assets, y=y.assets)
- text(x=x.assets, y=y.assets, labels=colnames(R), pos=4, cex=0.8)
- legend("bottomright", legend=c("sample", "simplex", "grid"),
- col=c("gray", "red", "green"),
- pch=c(1, 2, 5), bty="n")
- dev.off()
-}
-
-cat("Random portfolio simplex method fev biasing\n")
-if(file.exists("optimization_figures/fev_plot.png")){
- cat("file already exists\n")
-} else {
- png("optimization_figures/fev_plot.png")
- fev <- 0:5
- x.assets <- StdDev(R)
- y.assets <- colMeans(R)
- par(mfrow=c(2, 3))
- for(i in 1:length(fev)){
- rp <- rp_simplex(portfolio=portf.lo, 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))
- x.lower <- min(c(tmp.StdDev, x.assets)) * 0.85
- x.upper <- max(c(tmp.StdDev, x.assets)) * 1.15
- y.lower <- min(c(tmp.mean, y.assets)) * 0.85
- y.upper <- max(c(tmp.mean, y.assets)) * 1.15
- plot(x=tmp.StdDev, y=tmp.mean, main=paste("FEV =", fev[i]),
- ylab="mean", xlab="StdDev", col=rgb(0, 0, 100, 50, maxColorValue=255),
- xlim=c(x.lower, x.upper),
- ylim=c(y.lower, y.upper))
- points(x=x.assets, y=y.assets)
- text(x=x.assets, y=y.assets, labels=colnames(R), pos=4, cex=0.8)
- }
- par(mfrow=c(1,1))
- dev.off()
-}
-
-# # Calculate the turnover per period
-# turnover.rebalancing <- function(object){
-# weights <- extractWeights(object)
-# n <- nrow(weights)
-# out <- vector("numeric", n)
-# out[1] <- NA
-# for(i in 2:n){
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3379
More information about the Returnanalytics-commits
mailing list