[Returnanalytics-commits] r3429 - pkg/PortfolioAnalytics/R

[noreply at r-forge.r-project.org]

Author: rossbennett34
Date: 2014-06-20 01:04:29 +0200 (Fri, 20 Jun 2014)
New Revision: 3429

Modified:
   pkg/PortfolioAnalytics/R/black_litterman.R
   pkg/PortfolioAnalytics/R/moment.functions.R
Log:
Adding function to set portfolio moments using black litterman model.

Modified: pkg/PortfolioAnalytics/R/black_litterman.R
===================================================================
--- pkg/PortfolioAnalytics/R/black_litterman.R	2014-06-19 22:32:13 UTC (rev 3428)
+++ pkg/PortfolioAnalytics/R/black_litterman.R	2014-06-19 23:04:29 UTC (rev 3429)
@@ -38,9 +38,9 @@
 #' @param R returns
 #' @param P a K x N pick matrix
 #' @param Mu vector of length N of the prior expected values. The sample mean
-#' is used if \code{mu} is not provided as an argument.
-#' @param Sigma an N x N matrix of the prior covariance matrix. The sample covariance
-#' is used if \code{Sigma} is not provided as an argument.
+#' 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}.
 #' @return \itemize{
 #'   \item{BLMu:}{ posterior expected values}
 #'   \item{BLSigma:}{ posterior covariance matrix}
@@ -50,21 +50,19 @@
 #' 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, Sigma){
+black.litterman <- function(R, P, Mu=NULL, Sigma=NULL){
   
   # Compute the sample estimate if mu is null
-  if(hasArg(Mu)){
-    if(length(Mu) != NCOL(R)) stop("length of Mu must equal number of columns of R")
-  } else {
-    Mu <- colMeans(R)
+  if(is.null(Mu)){
+    Mu <- colMeans(R) 
   }
+  if(length(Mu) != NCOL(R)) stop("length of Mu must equal number of columns of R")
   
   # Compute the sample estimate if sigma is null
-  if(hasArg(Sigma)){
-    if(!all(dim(Sigma) == NCOL(R))) stop("dimensions of Sigma must equal number of columns of R")
-  } else {
+  if(is.null(Sigma)){
     Sigma <- cov(R)
   }
+  if(!all(dim(Sigma) == NCOL(R))) stop("dimensions of Sigma must equal number of columns of R")
   
   # Compute the Omega matrix and views value
   Omega = tcrossprod(P %*% Sigma, P)

Modified: pkg/PortfolioAnalytics/R/moment.functions.R
===================================================================
--- pkg/PortfolioAnalytics/R/moment.functions.R	2014-06-19 22:32:13 UTC (rev 3428)
+++ pkg/PortfolioAnalytics/R/moment.functions.R	2014-06-19 23:04:29 UTC (rev 3429)
@@ -332,6 +332,94 @@
   return(momentargs)
 }
 
+#' Portfolio Moments
+#' 
+#' Set portfolio moments for use by lower level optimization functions using
+#' a basic Black Litterman model.
+#' 
+#' @note If any of the objectives in the \code{portfolio} object have 
+#' \code{clean} as an argument, the cleaned returns are used to fit the model. 
+#' 
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of 
+#' asset returns
+#' @param portfolio an object of type \code{portfolio} specifying the 
+#' constraints and objectives for the optimization, see 
+#' \code{\link{portfolio.spec}}
+#' @param momentargs list containing arguments to be passed down to lower level 
+#' functions, default NULL
+#' @param P a K x N pick matrix representing views
+#' @param Mu vector of length N of the prior expected values. The sample mean
+#' 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 \dots any other passthru parameters
+#' @export
+portfolio.moments.bl <- function(R, portfolio, momentargs=NULL, P, Mu=NULL, Sigma=NULL, ...){
+  
+  
+  # If any of the objectives have clean as an argument, we fit the factor
+  # model with cleaned returns. Is this the desired behavior we want?
+  clean <- unlist(lapply(portfolio$objectives, function(x) x$arguments$clean))
+  if(!is.null(clean)){
+    if(length(unique(clean)) > 1){
+      warning(paste("Multiple methods detected for cleaning returns, default to use clean =", tmp[1]))
+    }
+    # This sets R as the cleaned returns for the rest of the function
+    # This is proably fine since the only other place R is used is for the 
+    # mu estimate
+    R <- Return.clean(R, method=clean[1])
+  }
+  
+  # Compute the Black Litterman estimates
+  B <- black.litterman(R=R, P=P, Mu=Mu, Sigma=Sigma)
+  
+  if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list()
+  if(is.null(portfolio$objectives)) {
+    warning("no objectives specified in portfolio")
+    next()
+  } else {
+    for (objective in portfolio$objectives){
+      switch(objective$name,
+             mean = {
+               if(is.null(momentargs$mu)) momentargs$mu = B$BLMu
+             },
+             var =,
+             sd =,
+             StdDev = { 
+               if(is.null(momentargs$mu)) momentargs$mu = B$BLMu
+               if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma
+             },
+             mVaR =,
+             VaR = {
+               if(is.null(momentargs$mu)) momentargs$mu = B$BLMu
+               if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma
+               if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R)
+               if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R)
+             },
+             es =,
+             mES =,
+             CVaR =,
+             cVaR =,
+             ETL=,
+             mETL=,
+             ES = {
+               # We don't want to calculate these moments if we have an ES 
+               # objective and are solving as an LP problem.
+               if(hasArg(ROI)) ROI=match.call(expand.dots=TRUE)$ROI else ROI=FALSE
+               if(!ROI){
+                 if(is.null(momentargs$mu)) momentargs$mu = B$BLMu
+                 if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma
+                 if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R)
+                 if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R)
+               }
+             }
+      ) # end switch on objectives    
+    }    
+  }    
+  return(momentargs)
+}
+
+
 ###############################################################################
 # $Id$
 ###############################################################################