[Returnanalytics-commits] r3449 - in pkg/PortfolioAnalytics: R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 30 05:35:53 CEST 2014
Author: rossbennett34
Date: 2014-06-30 05:35:52 +0200 (Mon, 30 Jun 2014)
New Revision: 3449
Added:
pkg/PortfolioAnalytics/sandbox/meucci_ffv.R
Modified:
pkg/PortfolioAnalytics/R/EntropyProg.R
pkg/PortfolioAnalytics/R/meucci_moments.R
pkg/PortfolioAnalytics/R/moment.functions.R
pkg/PortfolioAnalytics/man/meucci.moments.Rd
pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd
Log:
adding meucci fully flexible views
Modified: pkg/PortfolioAnalytics/R/EntropyProg.R
===================================================================
--- pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-29 17:42:14 UTC (rev 3448)
+++ pkg/PortfolioAnalytics/R/EntropyProg.R 2014-06-30 03:35:52 UTC (rev 3449)
@@ -51,6 +51,9 @@
{
stopifnot("package:nloptr" %in% search() || require("nloptr",quietly = TRUE) )
+ if( is.vector(b) ) b = matrix(b, nrow=length(b))
+ if( is.vector(beq) ) beq = matrix(beq, nrow=length(beq))
+
if( !length(b) ) A = matrix( ,nrow = 0, ncol = 0)
if( !length(b) ) b = matrix( ,nrow = 0, ncol = 0)
Modified: pkg/PortfolioAnalytics/R/meucci_moments.R
===================================================================
--- pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-29 17:42:14 UTC (rev 3448)
+++ pkg/PortfolioAnalytics/R/meucci_moments.R 2014-06-30 03:35:52 UTC (rev 3449)
@@ -6,7 +6,7 @@
#' framework as described in A. Meucci - "Fully Flexible Views: Theory and Practice".
#'
#' @param R xts object of asset returns
-#' @param p vector of posterior probabilities
+#' @param posterior_p vector of posterior probabilities
#' @return a list with the first and second moments
#' \itemize{
#' \item{\code{mu}: }{vector of expected returns}
@@ -16,13 +16,15 @@
#' A. Meucci - "Fully Flexible Views: Theory and Practice".
#' @author Ross Bennett
#' @export
-meucci.moments <- function(R, p){
+meucci.moments <- function(R, posterior_p){
R = coredata(R)
# expected return vector
- mu = t(R) %*% p
+ print(dim(t(R)))
+ print(dim(posterior_p))
+ mu = t(R) %*% posterior_p
# covariance matrix
- Scnd_Mom = t(R) %*% (R * (p %*% matrix( 1, 1, ncol(R))))
+ Scnd_Mom = t(R) %*% (R * (posterior_p %*% matrix( 1, 1, ncol(R))))
Scnd_Mom = ( Scnd_Mom + t(Scnd_Mom) ) / 2
sigma = Scnd_Mom - mu %*% t(mu)
list(mu=mu, sigma=sigma)
Modified: pkg/PortfolioAnalytics/R/moment.functions.R
===================================================================
--- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-29 17:42:14 UTC (rev 3448)
+++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-30 03:35:52 UTC (rev 3449)
@@ -164,7 +164,7 @@
set.portfolio.moments_v2 <- function(R,
portfolio,
momentargs=NULL,
- method=c("sample", "boudt", "black_litterman"),
+ method=c("sample", "boudt", "black_litterman", "meucci"),
...){
if(!hasArg(momentargs) | is.null(momentargs)) momentargs <- list()
@@ -197,6 +197,7 @@
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 = {
@@ -204,6 +205,12 @@
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)
+ },
+ 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
@@ -247,6 +254,9 @@
},
black_litterman = {
if(is.null(momentargs$mu)) momentargs$mu = B$BLMu
+ },
+ meucci = {
+ if(is.null(momentargs$mu)) momentargs$mu = meucci.model$mu
}
) # end nested switch on method
}, # end switch on mean
@@ -265,6 +275,10 @@
black_litterman = {
if(is.null(momentargs$mu)) momentargs$mu = B$BLMu
if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma
+ },
+ meucci = {
+ if(is.null(momentargs$mu)) momentargs$mu = meucci.model$mu
+ if(is.null(momentargs$sigma)) momentargs$sigma = meucci.model$sigma
}
) # end nested switch on method
}, # end switch on var, sd, StdDev
@@ -288,6 +302,12 @@
if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma
if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR)
if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR)
+ },
+ meucci = {
+ if(is.null(momentargs$mu)) momentargs$mu = meucci.model$mu
+ if(is.null(momentargs$sigma)) momentargs$sigma = meucci.model$sigma
+ if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR)
+ if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR)
}
) # end nested switch on method
}, # end switch on mVaR, VaR
@@ -320,13 +340,19 @@
if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma
if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR)
if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR)
+ },
+ meucci = {
+ if(is.null(momentargs$mu)) momentargs$mu = meucci.model$mu
+ if(is.null(momentargs$sigma)) momentargs$sigma = meucci.model$sigma
+ if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR)
+ if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR)
}
) # end nested switch on method
}
} # end switch on es, mES, CVaR, cVaR, ETL, mETL, ES
) # end switch on objectives
}
- }
+ }
return(momentargs)
}
Modified: pkg/PortfolioAnalytics/man/meucci.moments.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/meucci.moments.Rd 2014-06-29 17:42:14 UTC (rev 3448)
+++ pkg/PortfolioAnalytics/man/meucci.moments.Rd 2014-06-30 03:35:52 UTC (rev 3449)
@@ -3,12 +3,12 @@
\alias{meucci.moments}
\title{Compute moments}
\usage{
-meucci.moments(R, p)
+meucci.moments(R, posterior_p)
}
\arguments{
\item{R}{xts object of asset returns}
-\item{p}{vector of posterior probabilities}
+\item{posterior_p}{vector of posterior probabilities}
}
\value{
a list with the first and second moments
Modified: pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2014-06-29 17:42:14 UTC (rev 3448)
+++ pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2014-06-30 03:35:52 UTC (rev 3449)
@@ -5,7 +5,7 @@
\title{Portfolio Moments}
\usage{
set.portfolio.moments_v2(R, portfolio, momentargs = NULL,
- method = c("sample", "boudt", "black_litterman"), ...)
+ method = c("sample", "boudt", "black_litterman", "meucci"), ...)
}
\arguments{
\item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns}
Added: pkg/PortfolioAnalytics/sandbox/meucci_ffv.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/meucci_ffv.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/meucci_ffv.R 2014-06-30 03:35:52 UTC (rev 3449)
@@ -0,0 +1,45 @@
+library(PortfolioAnalytics)
+data(edhec)
+R <- edhec[,1:5]
+funds <- colnames(R)
+
+# 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.objective(portfolio=init.portf, type="risk", name="StdDev")
+
+# prior probabilities
+p <- rep(1 / nrow(R), nrow(R))
+
+# Express views
+# lambda is the ad-hoc multiplier
+# Meucci recommends -2 (very bearish), -1 (bearish), 1 (bullish), 2 (very bullish)
+
+# View 1: very bearish view on R[,1] - R[,2]
+V1 <- coredata(R[,1] - R[,2])
+b1 <- mean(V1) - 2 * sd(V1)
+
+# View 2: bearish view on R[,5] - R[,4]
+V2 <- coredata(R[,5] - R[,4])
+b2 <- mean(V2) - 1 * sd(V2)
+
+# Compute the posterior probabilities for each view
+# Equality constraints to constrain the posterior probabilities to sum to 1
+Aeq <- matrix(1, ncol=nrow(R))
+beq <- 1
+p1 <- EntropyProg(p, t(V1), b1, Aeq, beq)$p_
+p2 <- EntropyProg(p, t(V2), b2, Aeq, beq)$p_
+
+# Assign confidence weights to the views and pool opinions
+# 0.35 : confidence weight on reference model
+# 0.25 : confidence weight on view 1
+# 0.4 : confidence weight on view 2
+
+# 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)
+
More information about the Returnanalytics-commits
mailing list