[Returnanalytics-commits] r3407 - in pkg/PortfolioAnalytics: R demo man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jun 5 02:44:46 CEST 2014
Author: rossbennett34
Date: 2014-06-05 02:44:46 +0200 (Thu, 05 Jun 2014)
New Revision: 3407
Added:
pkg/PortfolioAnalytics/demo/higher_moments_boudt.R
Modified:
pkg/PortfolioAnalytics/R/moment.functions.R
pkg/PortfolioAnalytics/R/stat.factor.model.R
pkg/PortfolioAnalytics/demo/00Index
pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd
Log:
Adding checks for wrapper functions for residual cokurtosis matrices. Adding demo for using portfolio.moments.boudt. Fix portfolio.moments.boudt to use cleaned returns to fit model.
Modified: pkg/PortfolioAnalytics/R/moment.functions.R
===================================================================
--- pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-04 00:47:01 UTC (rev 3406)
+++ pkg/PortfolioAnalytics/R/moment.functions.R 2014-06-05 00:44:46 UTC (rev 3407)
@@ -256,6 +256,9 @@
#' Set portfolio moments for use by lower level optimization functions using
#' a statistical factor model based on the work of Kris Boudt.
#'
+#' @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
@@ -269,6 +272,18 @@
portfolio.moments.boudt <- function(R, portfolio, momentargs=NULL, k=1, ...){
# Fit the statistical factor model
+ # 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])
+ }
fit <- statistical.factor.model(R=R, k=k)
if(!hasArg(momentargs) | is.null(momentargs)) momentargs<-list()
@@ -284,12 +299,12 @@
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$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1)
if(is.null(momentargs$sigma)) momentargs$sigma = extractCovariance(fit)
},
mVaR =,
VaR = {
- if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean')),ncol=1);
+ if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,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)
@@ -305,7 +320,7 @@
# 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$mu)) momentargs$mu = matrix( as.vector(apply(R,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)
Modified: pkg/PortfolioAnalytics/R/stat.factor.model.R
===================================================================
--- pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-04 00:47:01 UTC (rev 3406)
+++ pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-05 00:44:46 UTC (rev 3407)
@@ -249,7 +249,12 @@
# mfactorM2 : double
# bbeta : vector of length NN
- # Should I add checks here? These are passed from cokurtosisSF which already has checks
+ if(!is.integer(NN)) NN <- as.integer(NN)
+ if(length(sstockM2) != NN) stop("sstockM2 must be a vector of length NN")
+ if(length(sstockM4) != NN) stop("sstockM4 must be a vector of length NN")
+ if(!is.double(mfactorM2)) mfactorM2 <- as.double(mfactorM2)
+ if(length(bbeta) != NN) stop("bbeta must be a vector of length NN")
+
.Call('residualcokurtosisSF', NN, sstockM2, sstockM4, mfactorM2, bbeta, PACKAGE="PortfolioAnalytics")
}
@@ -428,7 +433,11 @@
# ssstockM4 : numeric vector of length NN
# bbetacov : numeric vector of length NN * NN
- # Should I add checks here? These are passed from cokurtosisSF which already has checks
+ if(!is.integer(NN)) NN <- as.integer(NN)
+ if(length(sstockM2) != NN) stop("sstockM2 must be a vector of length NN")
+ if(length(sstockM4) != NN) stop("sstockM4 must be a vector of length NN")
+ if(length(bbetacov) != NN*NN) stop("bbetacov must be a vector of length NN*NN")
+
.Call('residualcokurtosisMF', NN, sstockM2, sstockM4, bbetacov, PACKAGE="PortfolioAnalytics")
}
Modified: pkg/PortfolioAnalytics/demo/00Index
===================================================================
--- pkg/PortfolioAnalytics/demo/00Index 2014-06-04 00:47:01 UTC (rev 3406)
+++ pkg/PortfolioAnalytics/demo/00Index 2014-06-05 00:44:46 UTC (rev 3407)
@@ -29,3 +29,4 @@
chart_concentration Demonstrate chart.Concentration
multiple_portfolio_optimization Demonstrate passing a list of portfolios to optimize.portfolio and optimize.portfolio.rebalancing
regime_switching Demonstrate optimization with support for regime switching to switch portfolios based on the regime.
+higher_moments_boudt Demonstrate using a statistical factor model to estimate moments based on work by Kris Boudt.
Added: pkg/PortfolioAnalytics/demo/higher_moments_boudt.R
===================================================================
--- pkg/PortfolioAnalytics/demo/higher_moments_boudt.R (rev 0)
+++ pkg/PortfolioAnalytics/demo/higher_moments_boudt.R 2014-06-05 00:44:46 UTC (rev 3407)
@@ -0,0 +1,48 @@
+library(PortfolioAnalytics)
+
+# Examples of solving optimization problems using a statistical factor model
+# to estimate the higher moments
+
+data(edhec)
+R <- edhec[, 1:10]
+funds <- colnames(R)
+
+# Construct initial portfolio
+init.portf <- portfolio.spec(assets=funds)
+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="long_only")
+init.portf <- add.objective(portfolio=init.portf, type="risk", name="ES",
+ arguments=list(p=0.9, clean="boudt"))
+
+# This is not necessary for the optimization, but demonstrates how the
+# moments are estimated using portfolio.moments.boudt
+cleanR <- Return.clean(R, "boudt")
+fit <- statistical.factor.model(cleanR, 3)
+sigma <- extractCovariance(fit)
+m3 <- extractCoskewness(fit)
+m4 <- extractCokurtosis(fit)
+
+moments.boudt <- portfolio.moments.boudt(R, init.portf, k=3)
+all.equal(moments.boudt$sigma, sigma)
+all.equal(moments.boudt$m3, m3)
+all.equal(moments.boudt$m4, m4)
+
+# Generate set of random portfolios
+rp <- random_portfolios(init.portf, 5000)
+
+# Optimization with sample estimates
+# The default for momentFUN is set.portfolio.moments which computes
+# the sample estimates of the moments
+minES.lo.sample <- optimize.portfolio(R=R, portfolio=init.portf,
+ rp=rp, optimize_method="random",
+ trace=TRUE)
+
+# Optimization with statistical factor model estimates of the moments
+minES.lo.boudt <- optimize.portfolio(R=R, portfolio=init.portf,
+ momentFUN=portfolio.moments.boudt,
+ k=3, rp=rp,
+ optimize_method="random",
+ trace=TRUE)
+
+
Modified: pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd 2014-06-04 00:47:01 UTC (rev 3406)
+++ pkg/PortfolioAnalytics/man/portfolio.moments.boudt.Rd 2014-06-05 00:44:46 UTC (rev 3407)
@@ -26,4 +26,9 @@
functions using a statistical factor model based on the
work of Kris Boudt.
}
+\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.
+}
More information about the Returnanalytics-commits
mailing list