[Returnanalytics-commits] r3432 - in pkg/PortfolioAnalytics: . R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 20 22:56:58 CEST 2014
Author: rossbennett34
Date: 2014-06-20 22:56:58 +0200 (Fri, 20 Jun 2014)
New Revision: 3432
Added:
pkg/PortfolioAnalytics/man/portfolio.moments.bl.Rd
pkg/PortfolioAnalytics/sandbox/testing_moments.R
Modified:
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/moment.functions.R
pkg/PortfolioAnalytics/man/black.litterman.Rd
pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd
Log:
refactor of set.portfolio.moments to incorporate different methods for estimating moments
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2014-06-20 03:48:49 UTC (rev 3431)
+++ pkg/PortfolioAnalytics/NAMESPACE 2014-06-20 20:56:58 UTC (rev 3432)
@@ -127,7 +127,6 @@
export(optimize.portfolio.rebalancing_v1)
export(optimize.portfolio_v1)
export(optimize.portfolio_v2)
-export(portfolio.moments.boudt)
export(portfolio.spec)
export(portfolio_risk_objective)
export(pos_limit_fail)
@@ -150,8 +149,6 @@
export(rp_transform)
export(scatterFUN)
export(set.portfolio.moments)
-export(set.portfolio.moments_v1)
-export(set.portfolio.moments_v2)
export(statistical.factor.model)
export(trailingFUN)
export(transaction_cost_constraint)
Modified: pkg/PortfolioAnalytics/R/moment.functions.R
===================================================================
--- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-20 03:48:49 UTC (rev 3431)
+++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-20 20:56:58 UTC (rev 3432)
@@ -21,43 +21,43 @@
#' @export
CCCgarch.MM = function(R, momentargs = NULL , ... )
{
- stopifnot("package:fGarch" %in% search() || require("fGarch",quietly=TRUE))
- if (!hasArg(momentargs) | is.null(momentargs))
- momentargs <- list()
- cAssets = ncol(R)
- T = nrow(R)
- if (!hasArg(mu)){
- mu = apply(R, 2, "mean")
- }else{ mu = match.call(expand.dots = TRUE)$mu }
- R = R - matrix( rep(mu,T) , nrow = T , byrow = TRUE )
- momentargs$mu = mu
- S = nextS = c();
- for( i in 1:cAssets ){
- gout = garchFit(formula ~ garch(1,1), data = R[,i],include.mean = F, cond.dist="QMLE", trace = FALSE )
- if( as.vector(gout at fit$coef["alpha1"]) < 0.01 ){
- sigmat = rep( sd( as.vector(R[,i])), length(R[,i]) ); nextSt = sd( as.vector(R[,i]))
- }else{
- sigmat = gout at sigma.t; nextSt = predict(gout)[1,3]
- }
- S = cbind( S , sigmat); nextS = c(nextS,nextSt)
+ stopifnot("package:fGarch" %in% search() || require("fGarch",quietly=TRUE))
+ if (!hasArg(momentargs) | is.null(momentargs))
+ momentargs <- list()
+ cAssets = ncol(R)
+ T = nrow(R)
+ if (!hasArg(mu)){
+ mu = apply(R, 2, "mean")
+ }else{ mu = match.call(expand.dots = TRUE)$mu }
+ R = R - matrix( rep(mu,T) , nrow = T , byrow = TRUE )
+ momentargs$mu = mu
+ S = nextS = c();
+ for( i in 1:cAssets ){
+ gout = garchFit(formula ~ garch(1,1), data = R[,i],include.mean = F, cond.dist="QMLE", trace = FALSE )
+ if( as.vector(gout at fit$coef["alpha1"]) < 0.01 ){
+ sigmat = rep( sd( as.vector(R[,i])), length(R[,i]) ); nextSt = sd( as.vector(R[,i]))
+ }else{
+ sigmat = gout at sigma.t; nextSt = predict(gout)[1,3]
}
- U = R/S; #filtered out time-varying volatility
- if (!hasArg(clean)){
- clean = match.call(expand.dots = TRUE)$clean
- }else{ clean = NULL }
- if(!is.null(clean)){
- cleanU <- try(Return.clean(U, method = clean))
- if (!inherits(cleanU, "try-error")) { U = cleanU }
- }
- Rcor = cor(U)
- D = diag( nextS ,ncol=cAssets )
- momentargs$sigma = D%*%Rcor%*%D
- # set volatility of all U to last observation, such that cov(rescaled U)=sigma
- uncS = sqrt(diag( cov(U) ))
- U = U*matrix( rep(nextS/uncS,T ) , ncol = cAssets , byrow = T )
- momentargs$m3 = PerformanceAnalytics:::M3.MM(U)
- momentargs$m4 = PerformanceAnalytics:::M4.MM(U)
- return(momentargs)
+ S = cbind( S , sigmat); nextS = c(nextS,nextSt)
+ }
+ U = R/S; #filtered out time-varying volatility
+ if (!hasArg(clean)){
+ clean = match.call(expand.dots = TRUE)$clean
+ }else{ clean = NULL }
+ if(!is.null(clean)){
+ cleanU <- try(Return.clean(U, method = clean))
+ if (!inherits(cleanU, "try-error")) { U = cleanU }
+ }
+ Rcor = cor(U)
+ D = diag( nextS ,ncol=cAssets )
+ momentargs$sigma = D%*%Rcor%*%D
+ # set volatility of all U to last observation, such that cov(rescaled U)=sigma
+ uncS = sqrt(diag( cov(U) ))
+ U = U*matrix( rep(nextS/uncS,T ) , ncol = cAssets , byrow = T )
+ momentargs$m3 = PerformanceAnalytics:::M3.MM(U)
+ momentargs$m4 = PerformanceAnalytics:::M4.MM(U)
+ return(momentargs)
}
#' set portfolio moments for use by lower level optimization functions
@@ -65,103 +65,17 @@
#' @param constraints an object of type "constraints" specifying the constraints for the optimization, see \code{\link{constraint}}
#' @param momentargs list containing arguments to be passed down to lower level functions, default NULL
#' @param \dots any other passthru parameters
-#' @export
set.portfolio.moments_v1 <- function(R, constraints, momentargs=NULL,...){
-
- if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list()
- if(is.null(constraints$objectives)) {
- warning("no objectives specified in constraints")
- next()
- } else {
-
- lcl <- grep('garch', constraints)
- if (!identical(lcl, integer(0))) {
- for (objective in constraints[lcl]) {
- objective = unlist(objective)
- if( is.null( objective$garch ) ) next
- if (objective$garch){
- if (is.null(momentargs$mu)|is.null(momentargs$sigma)|is.null(momentargs$m3)|is.null(momentargs$m4))
- {
- momentargs = CCCgarch.MM(R,clean=objective$arguments.clean,...)
- }
- }
- }
- }
-
-
- lcl<-grep('clean',constraints)
- if(!identical(lcl,integer(0))) {
- for (objective in constraints[lcl]){
- objective = unlist(objective)
- #if(!is.null(objective$arguments$clean)) {
- if (!is.null(objective$arguments.clean)){
- if (is.null(momentargs$mu)|is.null(momentargs$sigma)|is.null(momentargs$m3)|is.null(momentargs$m4))
- {
- # cleanR<-try(Return.clean(R,method=objective$arguments$clean))
- cleanR <- try(Return.clean(R, method = objective$arguments.clean,...))
- if(!inherits(cleanR,"try-error")) {
- momentargs$mu = matrix( as.vector(apply(cleanR,2,'mean')),ncol=1);
- momentargs$sigma = cov(cleanR);
- momentargs$m3 = PerformanceAnalytics:::M3.MM(cleanR)
- momentargs$m4 = PerformanceAnalytics:::M4.MM(cleanR)
- #' FIXME NOTE: this isn't perfect as it overwrites the moments for all objectives, not just one with clean='boudt'
- }
- }
- }
- }
- }
- for (objective in constraints$objectives){
- switch(objective$name,
- sd =,
- StdDev = {
- if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1);
- if(is.null(momentargs$sigma)) momentargs$sigma = cov(R, use='pairwise.complete.obs')
- },
- var =,
- mVaR =,
- VaR = {
- if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1);
- if(is.null(momentargs$sigma)) momentargs$sigma = cov(R)
- 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 =,
- ES = {
- if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1);
- if(is.null(momentargs$sigma)) momentargs$sigma = cov(R)
- 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)
-}
-
-#' set portfolio moments for use by lower level optimization functions
-#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns
-#' @param portfolio an object of type "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 \dots any other passthru parameters
-#' @aliases set.portfolio.moments
-#' @rdname set.portfolio.moments
-#' @export
-set.portfolio.moments_v2 <- function(R, portfolio, momentargs=NULL,...){
if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list()
- if(is.null(portfolio$objectives)) {
- warning("no objectives specified in portfolio")
+ if(is.null(constraints$objectives)) {
+ warning("no objectives specified in constraints")
next()
} else {
- # How would this be specified in the new portfolio.spec? As a constraint or in the portfolio part?
- #
- lcl <- grep('garch', portfolio)
+ lcl <- grep('garch', constraints)
if (!identical(lcl, integer(0))) {
- for (objective in portfolio[lcl]) {
+ for (objective in constraints[lcl]) {
objective = unlist(objective)
if( is.null( objective$garch ) ) next
if (objective$garch){
@@ -174,9 +88,9 @@
}
- lcl<-grep('clean',portfolio)
+ lcl<-grep('clean',constraints)
if(!identical(lcl,integer(0))) {
- for (objective in portfolio[lcl]){
+ for (objective in constraints[lcl]){
objective = unlist(objective)
#if(!is.null(objective$arguments$clean)) {
if (!is.null(objective$arguments.clean)){
@@ -195,17 +109,14 @@
}
}
}
- for (objective in portfolio$objectives){
+ for (objective in constraints$objectives){
switch(objective$name,
- mean = {
- if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1)
- },
- var =,
sd =,
StdDev = {
if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1);
if(is.null(momentargs$sigma)) momentargs$sigma = cov(R, use='pairwise.complete.obs')
},
+ var =,
mVaR =,
VaR = {
if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1);
@@ -217,6 +128,173 @@
mES =,
CVaR =,
cVaR =,
+ ES = {
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1);
+ if(is.null(momentargs$sigma)) momentargs$sigma = cov(R)
+ 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)
+}
+
+#' Portfolio Moments
+#'
+#' Set portfolio moments for use by lower level optimization functions. Currently
+#' three methods for setting the moments are available
+#'
+#' \itemize{
+#' \item{sample: }{sample estimates are used for the moments}
+#' \item{boudt: }{estimate the second, third, and fourth moments using a
+#' statistical factor model based on the work of Kris Boudt.}
+#' See \code{\link{fit.statistical.factor.model}}
+#' \item{black_litterman: }{estimate the first and second moments using the
+#' Black Litterman Formula. See \code{\link{black.litterman}}}.
+#' }
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns
+#' @param portfolio an object of type "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 method the method used to estimate portfolio moments. Valid choices include "sample", "boudt", and "black_litterman".
+#' @param \dots any other passthru parameters
+#' @aliases set.portfolio.moments
+#' @rdname set.portfolio.moments
+set.portfolio.moments_v2 <- function(R,
+ portfolio,
+ momentargs=NULL,
+ method=c("sample", "boudt", "black_litterman"),
+ ...){
+
+ if(!hasArg(momentargs) | is.null(momentargs)) momentargs <- list()
+ if(is.null(portfolio$objectives)) {
+ warning("no objectives specified in portfolio")
+ next()
+ } else {
+ method <- match.arg(method)
+
+ # If any of the objectives have clean as an argument, we fit the factor
+ # model and Black Litterman model with cleaned returns.
+ 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]))
+ }
+ cleanR <- Return.clean(R, method=clean[1])
+ cleaned <- TRUE
+ } else {
+ cleaned <- FALSE
+ }
+
+ if(cleaned){
+ tmpR <- cleanR
+ } else {
+ tmpR <- R
+ }
+
+ # Fit model based on method
+ switch(method,
+ boudt = {
+ if(hasArg(k)) k=match.call(expand.dots=TRUE)$k else k=1
+ 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)
+ }
+ ) # end switch for fitting models based on method
+
+ lcl <- grep('garch', portfolio)
+ if (!identical(lcl, integer(0))) {
+ for (objective in portfolio[lcl]) {
+ objective = unlist(objective)
+ if( is.null( objective$garch ) ) next
+ if (objective$garch){
+ if (is.null(momentargs$mu)|is.null(momentargs$sigma)|is.null(momentargs$m3)|is.null(momentargs$m4))
+ {
+ momentargs = CCCgarch.MM(R,clean=objective$arguments.clean,...)
+ }
+ }
+ }
+ }
+
+ for (objective in portfolio$objectives){
+ # The returns should already have been cleaned if any objective has
+ # arguments=list(clean=*). One drawback is if different cleaning
+ # methods are being used for different objectives, only the first
+ # method for cleaning is used. This is mor efficient and avoids "re"-cleaning.
+ # Not sure that anyone would want to use different cleaning methods anyway.
+ # Another thing is that we don't recalculate the moments. So if a moment
+ # is set with un-cleaned returns then the next objective may have
+ # clean="boudt", but the cleaned returns are not used for that moment.
+ # I think this is more consisent with how the objectives are specified
+ # rather than overwriting all moments, but I am open to other ideas or
+ # suggestions.
+ if(!is.null(objective$arguments$clean)){
+ tmpR <- cleanR
+ } else {
+ tmpR <- R
+ }
+ switch(objective$name,
+ mean = {
+ switch(method,
+ sample =,
+ boudt = {
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean', na.rm=TRUE)), ncol=1)
+ },
+ black_litterman = {
+ if(is.null(momentargs$mu)) momentargs$mu = B$BLMu
+ }
+ ) # end nested switch on method
+ }, # end switch on mean
+ var =,
+ sd =,
+ StdDev = {
+ switch(method,
+ sample = {
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean', na.rm=TRUE)), ncol=1);
+ if(is.null(momentargs$sigma)) momentargs$sigma = cov(tmpR, use='pairwise.complete.obs')
+ },
+ boudt = {
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean', na.rm=TRUE)), ncol=1);
+ if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit)
+ },
+ black_litterman = {
+ if(is.null(momentargs$mu)) momentargs$mu = B$BLMu
+ if(is.null(momentargs$sigma)) momentargs$sigma = B$BLSigma
+ }
+ ) # end nested switch on method
+ }, # end switch on var, sd, StdDev
+ mVaR =,
+ VaR = {
+ switch(method,
+ sample = {
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean')), ncol=1);
+ if(is.null(momentargs$sigma)) momentargs$sigma = cov(tmpR)
+ if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR)
+ if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR)
+ },
+ boudt = {
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean')), ncol=1);
+ if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit)
+ if(is.null(momentargs$m3)) momentargs$m3 = extractCoskewness(fit)
+ if(is.null(momentargs$m4)) momentargs$m4 = extractCokurtosis(fit)
+ },
+ black_litterman = {
+ 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(tmpR)
+ if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR)
+ }
+ ) # end nested switch on method
+ }, # end switch on mVaR, VaR
+ es =,
+ mES =,
+ CVaR =,
+ cVaR =,
ETL=,
mETL=,
ES = {
@@ -224,12 +302,28 @@
# 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 = matrix( as.vector(apply(R,2,'mean')),ncol=1);
- if(is.null(momentargs$sigma)) momentargs$sigma = cov(R)
- if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R)
- if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R)
+ switch(method,
+ sample = {
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean')), ncol=1);
+ if(is.null(momentargs$sigma)) momentargs$sigma = cov(tmpR)
+ if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(tmpR)
+ if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(tmpR)
+ },
+ boudt = {
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(tmpR, 2, 'mean')), ncol=1);
+ if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit)
+ if(is.null(momentargs$m3)) momentargs$m3 = extractCoskewness(fit)
+ if(is.null(momentargs$m4)) momentargs$m4 = extractCokurtosis(fit)
+ },
+ black_litterman = {
+ 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(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
}
}
@@ -241,14 +335,14 @@
set.portfolio.moments <- set.portfolio.moments_v2
garch.mm <- function(R,mu_ts, covlist,momentargs=list(),...) {
- #momentargs<-list()
- #momentargs$mu<-mu_ts[last(index(R)),]
- momentargs$mu<-mu_ts[last(index(R)),]
-
- momentargs$sigma<-covlist[as.character(last(index(R)))]
- if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R)
- if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R)
- return(momentargs)
+ #momentargs<-list()
+ #momentargs$mu<-mu_ts[last(index(R)),]
+ momentargs$mu<-mu_ts[last(index(R)),]
+
+ momentargs$sigma<-covlist[as.character(last(index(R)))]
+ if(is.null(momentargs$m3)) momentargs$m3 = PerformanceAnalytics:::M3.MM(R)
+ if(is.null(momentargs$m4)) momentargs$m4 = PerformanceAnalytics:::M4.MM(R)
+ return(momentargs)
}
#' Portfolio Moments
@@ -268,7 +362,6 @@
#' functions, default NULL
#' @param k number of factors used for fitting statistical factor model
#' @param \dots any other passthru parameters
-#' @export
portfolio.moments.boudt <- function(R, portfolio, momentargs=NULL, k=1, ...){
# Fit the statistical factor model
@@ -353,7 +446,6 @@
#' @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, ...){
Modified: pkg/PortfolioAnalytics/man/black.litterman.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-20 03:48:49 UTC (rev 3431)
+++ pkg/PortfolioAnalytics/man/black.litterman.Rd 2014-06-20 20:56:58 UTC (rev 3432)
@@ -3,7 +3,7 @@
\alias{black.litterman}
\title{Black Litterman Estimates}
\usage{
-black.litterman(R, P, Mu, Sigma)
+black.litterman(R, P, Mu = NULL, Sigma = NULL)
}
\arguments{
\item{R}{returns}
@@ -11,10 +11,10 @@
\item{P}{a K x N pick matrix}
\item{Mu}{vector of length N of the prior expected values. The sample mean
-is used if \code{mu} is not provided as an argument.}
+is used if \code{Mu=NULL}.}
-\item{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.}
+\item{Sigma}{an N x N matrix of the prior covariance matrix. The sample
+covariance is used if \code{Sigma=NULL}.}
}
\value{
\itemize{
Added: pkg/PortfolioAnalytics/man/portfolio.moments.bl.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/portfolio.moments.bl.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/portfolio.moments.bl.Rd 2014-06-20 20:56:58 UTC (rev 3432)
@@ -0,0 +1,38 @@
+% Generated by roxygen2 (4.0.1): do not edit by hand
+\name{portfolio.moments.bl}
+\alias{portfolio.moments.bl}
+\title{Portfolio Moments}
+\usage{
+portfolio.moments.bl(R, portfolio, momentargs = NULL, P, Mu = NULL,
+ Sigma = NULL, ...)
+}
+\arguments{
+\item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of
+asset returns}
+
+\item{portfolio}{an object of type \code{portfolio} specifying the
+constraints and objectives for the optimization, see
+\code{\link{portfolio.spec}}}
+
+\item{momentargs}{list containing arguments to be passed down to lower level
+functions, default NULL}
+
+\item{P}{a K x N pick matrix representing views}
+
+\item{Mu}{vector of length N of the prior expected values. The sample mean
+is used if \code{Mu=NULL}.}
+
+\item{Sigma}{an N x N matrix of the prior covariance matrix. The sample
+covariance is used if \code{Sigma=NULL}.}
+
+\item{\dots}{any other passthru parameters}
+}
+\description{
+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.
+}
+
Modified: pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2014-06-20 03:48:49 UTC (rev 3431)
+++ pkg/PortfolioAnalytics/man/set.portfolio.moments.Rd 2014-06-20 20:56:58 UTC (rev 3432)
@@ -2,9 +2,10 @@
\name{set.portfolio.moments_v2}
\alias{set.portfolio.moments}
\alias{set.portfolio.moments_v2}
-\title{set portfolio moments for use by lower level optimization functions}
+\title{Portfolio Moments}
\usage{
-set.portfolio.moments_v2(R, portfolio, momentargs = NULL, ...)
+set.portfolio.moments_v2(R, portfolio, momentargs = NULL,
+ method = c("sample", "boudt", "black_litterman"), ...)
}
\arguments{
\item{R}{an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns}
@@ -13,9 +14,22 @@
\item{momentargs}{list containing arguments to be passed down to lower level functions, default NULL}
+\item{method}{the method used to estimate portfolio moments. Valid choices include "sample", "boudt", and "black_litterman".}
+
\item{\dots}{any other passthru parameters}
}
\description{
-set portfolio moments for use by lower level optimization functions
+Set portfolio moments for use by lower level optimization functions. Currently
+three methods for setting the moments are available
}
+\details{
+\itemize{
+ \item{sample: }{sample estimates are used for the moments}
+ \item{boudt: }{estimate the second, third, and fourth moments using a
+ statistical factor model based on the work of Kris Boudt.}
+ See \code{\link{fit.statistical.factor.model}}
+ \item{black_litterman: }{estimate the first and second moments using the
+ Black Litterman Formula. See \code{\link{black.litterman}}}.
+}
+}
Added: pkg/PortfolioAnalytics/sandbox/testing_moments.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_moments.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/testing_moments.R 2014-06-20 20:56:58 UTC (rev 3432)
@@ -0,0 +1,59 @@
+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="ES",
+ arguments=list(p=0.9))
+
+# uncleaned R
+moments.sample <- set.portfolio.moments(R, init.portf)
+all.equal(moments.sample$mu, matrix(colMeans(R), ncol=1))
+all.equal(moments.sample$sigma, cov(R))
+all.equal(moments.sample$m3, PerformanceAnalytics:::M3.MM(R))
+all.equal(moments.sample$m4, PerformanceAnalytics:::M4.MM(R))
+
+moments.boudt <- set.portfolio.moments(R, init.portf, method="boudt", k=3)
+fit <- statistical.factor.model(R, 3)
+all.equal(moments.boudt$mu, matrix(colMeans(R), ncol=1))
+all.equal(moments.boudt$sigma, extractCovariance(fit))
+all.equal(moments.boudt$m3, extractCoskewness(fit))
+all.equal(moments.boudt$m4, extractCokurtosis(fit))
+
+moments.bl <- set.portfolio.moments(R, init.portf, method="black_litterman")
+BL <- black.litterman(R, matrix(rep(1, ncol(R)), 1))
+all.equal(moments.bl$mu, BL$BLMu)
+all.equal(moments.bl$sigma, BL$BLSigma)
+all.equal(moments.bl$m3, PerformanceAnalytics:::M3.MM(R))
+all.equal(moments.bl$m4, PerformanceAnalytics:::M4.MM(R))
+
+
+# cleaned R
+cleanR <- Return.clean(R, method="boudt")
+init.portf$objectives[[1]]$arguments$clean <- "boudt"
+
+moments.sample <- set.portfolio.moments(R, init.portf)
+all.equal(moments.sample$mu, matrix(colMeans(cleanR), ncol=1))
+all.equal(moments.sample$sigma, cov(cleanR))
+all.equal(moments.sample$m3, PerformanceAnalytics:::M3.MM(cleanR))
+all.equal(moments.sample$m4, PerformanceAnalytics:::M4.MM(cleanR))
+
+moments.boudt <- set.portfolio.moments(R, init.portf, method="boudt", k=3)
+fit <- statistical.factor.model(cleanR, 3)
+all.equal(moments.boudt$mu, matrix(colMeans(cleanR), ncol=1))
+all.equal(moments.boudt$sigma, extractCovariance(fit))
+all.equal(moments.boudt$m3, extractCoskewness(fit))
+all.equal(moments.boudt$m4, extractCokurtosis(fit))
+
+moments.bl <- set.portfolio.moments(R, init.portf, method="black_litterman")
+BL <- black.litterman(cleanR, matrix(rep(1, ncol(cleanR)), 1))
+all.equal(moments.bl$mu, BL$BLMu)
+all.equal(moments.bl$sigma, BL$BLSigma)
+all.equal(moments.bl$m3, PerformanceAnalytics:::M3.MM(cleanR))
+all.equal(moments.bl$m4, PerformanceAnalytics:::M4.MM(cleanR))
+
More information about the Returnanalytics-commits
mailing list