[Returnanalytics-commits] r3450 - in pkg/PortfolioAnalytics: R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 30 21:36:42 CEST 2014
Author: rossbennett34
Date: 2014-06-30 21:36:42 +0200 (Mon, 30 Jun 2014)
New Revision: 3450
Modified:
pkg/PortfolioAnalytics/R/black_litterman.R
pkg/PortfolioAnalytics/R/meucci_moments.R
pkg/PortfolioAnalytics/R/moment.functions.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/man/black.litterman.Rd
pkg/PortfolioAnalytics/sandbox/meucci_ffv.R
Log:
minor fixes to the meucci ffv code
Modified: pkg/PortfolioAnalytics/R/black_litterman.R
===================================================================
--- pkg/PortfolioAnalytics/R/black_litterman.R 2014-06-30 03:35:52 UTC (rev 3449)
+++ pkg/PortfolioAnalytics/R/black_litterman.R 2014-06-30 19:36:42 UTC (rev 3450)
@@ -41,6 +41,7 @@
#' is used if \code{Mu=NULL}.
#' @param Sigma an N x N matrix of the prior covariance matrix. The sample
#' covariance is used if \code{Sigma=NULL}.
+#' @param Views a vector of length K of the views
#' @return \itemize{
#' \item{BLMu:}{ posterior expected values}
#' \item{BLSigma:}{ posterior covariance matrix}
@@ -50,7 +51,7 @@
#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}.
#' @seealso \code{\link{BlackLittermanFormula}}
#' @export
-black.litterman <- function(R, P, Mu=NULL, Sigma=NULL){
+black.litterman <- function(R, P, Mu=NULL, Sigma=NULL, Views=NULL){
# Compute the sample estimate if mu is null
if(is.null(Mu)){
@@ -66,7 +67,7 @@
# Compute the Omega matrix and views value
Omega = tcrossprod(P %*% Sigma, P)
- Views = as.numeric(sqrt( diag( Omega ) ))
+ if(is.null(Views)) Views = as.numeric(sqrt( diag( Omega ) ))
B = BlackLittermanFormula( Mu, Sigma, P, Views, Omega )
return(B)
}
Modified: pkg/PortfolioAnalytics/R/meucci_moments.R
===================================================================
--- pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-30 03:35:52 UTC (rev 3449)
+++ pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-30 19:36:42 UTC (rev 3450)
@@ -19,8 +19,6 @@
meucci.moments <- function(R, posterior_p){
R = coredata(R)
# expected return vector
- print(dim(t(R)))
- print(dim(posterior_p))
mu = t(R) %*% posterior_p
# covariance matrix
Modified: pkg/PortfolioAnalytics/R/moment.functions.R
===================================================================
--- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-30 03:35:52 UTC (rev 3449)
+++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-30 19:36:42 UTC (rev 3450)
@@ -197,19 +197,17 @@
switch(method,
boudt = {
if(hasArg(k)) k=match.call(expand.dots=TRUE)$k else k=1
- print(k)
fit <- statistical.factor.model(R=tmpR, k=k)
},
black_litterman = {
if(hasArg(P)) P=match.call(expand.dots=TRUE)$P else P=matrix(rep(1, ncol(R)), nrow=1)
if(hasArg(Mu)) Mu=match.call(expand.dots=TRUE)$Mu else Mu=NULL
if(hasArg(Sigma)) Sigma=match.call(expand.dots=TRUE)$Sigma else Sigma=NULL
- B <- black.litterman(R=tmpR, P=P, Mu=Mu, Sigma=Sigma)
+ if(hasArg(Views)) Views=match.call(expand.dots=TRUE)$Views else Views=NULL
+ B <- black.litterman(R=tmpR, P=P, Mu=Mu, Sigma=Sigma, Views=Views)
},
meucci = {
if(hasArg(posterior_p)) posterior_p=match.call(expand.dots=TRUE)$posterior_p else posterior_p=rep(1 / nrow(R), nrow(R))
- print(match.call(expand.dots=TRUE))
- print(posterior_p)
meucci.model <- meucci.moments(R=tmpR, posterior_p=posterior_p)
}
) # end switch for fitting models based on method
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-06-30 03:35:52 UTC (rev 3449)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-06-30 19:36:42 UTC (rev 3450)
@@ -571,7 +571,7 @@
# match the args for momentFUN
.formals <- formals(momentFUN)
- .formals <- modify.args(formals=.formals, arglist=NULL, ..., dots=FALSE)
+ .formals <- modify.args(formals=.formals, arglist=list(...), dots=TRUE)
# ** pass ROI=TRUE to set.portfolio.moments so the moments are not calculated
if(optimize_method %in% c("ROI", "quadprog", "glpk", "symphony", "ipop", "cplex")){
obj_names <- unlist(lapply(portfolio$objectives, function(x) x$name))
Modified: pkg/PortfolioAnalytics/man/black.litterman.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-30 03:35:52 UTC (rev 3449)
+++ pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-30 19:36:42 UTC (rev 3450)
@@ -3,7 +3,7 @@
\alias{black.litterman}
\title{Black Litterman Estimates}
\usage{
-black.litterman(R, P, Mu = NULL, Sigma = NULL)
+black.litterman(R, P, Mu = NULL, Sigma = NULL, Views = NULL)
}
\arguments{
\item{R}{returns}
@@ -15,6 +15,8 @@
\item{Sigma}{an N x N matrix of the prior covariance matrix. The sample
covariance is used if \code{Sigma=NULL}.}
+
+\item{Views}{a vector of length K of the views}
}
\value{
\itemize{
Modified: pkg/PortfolioAnalytics/sandbox/meucci_ffv.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/meucci_ffv.R 2014-06-30 03:35:52 UTC (rev 3449)
+++ pkg/PortfolioAnalytics/sandbox/meucci_ffv.R 2014-06-30 19:36:42 UTC (rev 3450)
@@ -1,3 +1,6 @@
+# Demonstrate Meucci's Fully Flexible Views framework to estimate moments and
+# use as inputs for a minimum variance optimization
+
library(PortfolioAnalytics)
data(edhec)
R <- edhec[,1:5]
@@ -5,15 +8,20 @@
# Construct initial portfolio
init.portf <- portfolio.spec(assets=funds)
-init.portf <- add.constraint(portfolio=init.portf, type="full_investment")
-init.portf <- add.constraint(portfolio=init.portf, type="long_only")
+init.portf <- add.constraint(portfolio=init.portf, type="weight_sum",
+ min_sum=0.99, max_sum=1.01)
+init.portf <- add.constraint(portfolio=init.portf, type="box",
+ min=0.05, max=0.5)
init.portf <- add.objective(portfolio=init.portf, type="risk", name="StdDev")
+init.portf <- add.objective(portfolio=init.portf, type="return", name="mean", multiplier=0)
# prior probabilities
p <- rep(1 / nrow(R), nrow(R))
# Express views
# lambda is the ad-hoc multiplier
+# m_k = m(V_k) + lambda * sigma(V_k)
+# sigma(k) is a measure of volatility (i.e. standard deviation, interquartile range, etc.)
# Meucci recommends -2 (very bearish), -1 (bearish), 1 (bullish), 2 (very bullish)
# View 1: very bearish view on R[,1] - R[,2]
@@ -39,7 +47,50 @@
# Prior posterior of pooled opinions
p_ <- cbind(p, p1, p2) %*% c(0.35 , 0.25 , 0.4)
-m1 <- meucci.moments(R, p_)
-m2 <- set.portfolio.moments(R = R, portfolio=init.portf, method="meucci", posterior_p=p_)
-all.equal(m1, m2)
+# Generate random portfolios
+rp <- random_portfolios(init.portf, 10000)
+# Optimization using first and second moments estimated from Meucci's Fully
+# Flexible Views framework.
+opt.meucci <- optimize.portfolio(R,
+ init.portf,
+ optimize_method="random",
+ rp=rp,
+ trace=TRUE,
+ method="meucci",
+ posterior_p=p_)
+
+
+# Optimization using sample estimates for first and second moments
+opt.sample <- optimize.portfolio(R,
+ init.portf,
+ optimize_method="random",
+ rp=rp,
+ trace=TRUE)
+
+#Extract the stats for plotting
+stats.meucci <- extractStats(opt.meucci)
+stats.sample <- extractStats(opt.sample)
+
+
+# Plots
+# Plot the optimal weights
+chart.Weights(combine.optimizations(list(meucci=opt.meucci, sample=opt.sample)))
+
+# Plot the risk-reward of each chart on the same scale
+xrange <- range(c(stats.meucci[,"StdDev"], stats.sample[,"StdDev"]))
+yrange <- range(c(stats.meucci[,"mean"], stats.sample[,"mean"]))
+layout(matrix(c(1,2)), widths=1, heights=1)
+# c(bottom, left, top, right)
+par(mar=c(0, 4, 4, 4) + 0.1)
+plot(x=stats.meucci[,"StdDev"], stats.meucci[,"mean"], xlab="", ylab="mean",
+ xlim=xrange, ylim=yrange, xaxt="n", yaxt="n")
+axis(2, pretty(yrange), cex.axis=0.8)
+legend("topright", legend="Meucci", bty="n")
+par(mar=c(5, 4, 0, 4) + 0.1)
+plot(x=stats.sample[,"StdDev"], stats.sample[,"mean"], xlab="StdDev", ylab="",
+ xlim=xrange, ylim=yrange, yaxt="n", cex.axis=0.8)
+axis(4, pretty(yrange), cex.axis=0.8)
+legend("topright", legend="Sample", bty="n")
+par(mar=c(5, 4, 4, 2) + 0.1)
+layout(matrix(1), widths=1, heights=1)
More information about the Returnanalytics-commits
mailing list