[Returnanalytics-commits] r3401 - in pkg/PortfolioAnalytics: . R demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed May 28 21:54:24 CEST 2014
Author: rossbennett34
Date: 2014-05-28 21:54:24 +0200 (Wed, 28 May 2014)
New Revision: 3401
Modified:
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/generics.R
pkg/PortfolioAnalytics/R/portfolio.R
pkg/PortfolioAnalytics/demo/regime_switching.R
Log:
Adding print method and checks for regime.portfolios. Revising regime switching demo
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2014-05-28 05:33:17 UTC (rev 3400)
+++ pkg/PortfolioAnalytics/NAMESPACE 2014-05-28 19:54:24 UTC (rev 3401)
@@ -138,6 +138,7 @@
S3method(print,optimize.portfolio.ROI)
S3method(print,portfolio.list)
S3method(print,portfolio)
+S3method(print,regime.portfolios)
S3method(print,summary.optimize.portfolio.rebalancing)
S3method(print,summary.optimize.portfolio)
S3method(summary,efficient.frontier)
Modified: pkg/PortfolioAnalytics/R/generics.R
===================================================================
--- pkg/PortfolioAnalytics/R/generics.R 2014-05-28 05:33:17 UTC (rev 3400)
+++ pkg/PortfolioAnalytics/R/generics.R 2014-05-28 19:54:24 UTC (rev 3401)
@@ -992,3 +992,20 @@
}
}
+#' @method print regime.portfolios
+#' @S3method print regime.portfolios
+#' @export
+print.regime.portfolios <- function(x, ...){
+
+ cat(rep("*", 50) ,"\n", sep="")
+ cat("PortfolioAnalytics Regime Switching Specification", "\n")
+ cat(rep("*", 50) ,"\n\n", sep="")
+
+ # Should we print the regime object information?
+
+ portf <- x$portfolio.list
+ for(i in 1:length(portf)){
+ cat("Regime ", i, " Portfolio", "\n", sep="")
+ print(portf[[i]])
+ }
+}
Modified: pkg/PortfolioAnalytics/R/portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/portfolio.R 2014-05-28 05:33:17 UTC (rev 3400)
+++ pkg/PortfolioAnalytics/R/portfolio.R 2014-05-28 19:54:24 UTC (rev 3401)
@@ -150,6 +150,13 @@
n.portfolios <- length(portfolios)
if(n.regimes != n.portfolios) stop("Number of portfolios must match the number of regimes")
+ # Check to ensure the assets in each portfolio are equal
+ for(i in 2:length(portfolios)){
+ if(!identical(portfolios[[1]]$assets, portfolios[[i]]$assets)){
+ stop("The assets in each portfolio must be identical")
+ }
+ }
+
# structure and return
return(structure(list(regime=regime, portfolio.list=portfolios),
class=c("regime.portfolios", "portfolio")))
Modified: pkg/PortfolioAnalytics/demo/regime_switching.R
===================================================================
--- pkg/PortfolioAnalytics/demo/regime_switching.R 2014-05-28 05:33:17 UTC (rev 3400)
+++ pkg/PortfolioAnalytics/demo/regime_switching.R 2014-05-28 19:54:24 UTC (rev 3401)
@@ -6,11 +6,11 @@
# create an xts object of regimes
# Here I just randomly samples values to create regime 1 or regime 2. In
-# practice, this could based on volatility of other regime switching models
+# practice, this could based on volatility or other regime switching models
set.seed(123)
-regime <- xts(sample(1:2, nrow(R), replace=TRUE), index(R))
+regime <- xts(sample(1:2, nrow(R), replace=TRUE, prob=c(0.3, 0.7)), index(R))
-# portfolio for regime 1
+# Portfolio for regime 1
port1 <- portfolio.spec(funds)
port1 <- add.constraint(port1, "weight_sum", min_sum=0.99, max_sum=1.01)
port1 <- add.constraint(port1, "box", min=0.1, max=0.5)
@@ -18,34 +18,44 @@
port1 <- add.objective(port1, type="risk_budget", name="ES",
arguments=list(p=0.9), max_prisk=0.5)
-# portfolio for regime 2
+# Portfolio for regime 2
port2 <- portfolio.spec(funds)
port2 <- add.constraint(port2, "weight_sum", min_sum=0.99, max_sum=1.01)
port2 <- add.constraint(port2, "box", min=0, max=0.6)
port2 <- add.objective(port2, type="risk", name="StdDev")
port2 <- add.objective(port2, type="risk_budget", name="StdDev", max_prisk=0.5)
+# Combine the portfolios
portfolios <- combine.portfolios(list(port1, port2))
+# with the regime and portfolios
regime.port <- regime.portfolios(regime, portfolios)
+regime.port
-# should result in portfolio for regime 1
+# Should result in portfolio for regime 2
opt1 <- optimize.portfolio(R, regime.port,
optimize_method="random",
search_size=2000,
trace=TRUE)
+opt1
+opt1$regime
-# should result in portfolio for regime 2
-opt2 <- optimize.portfolio(R[1:(nrow(R)-2)], regime.port,
+# Should result in portfolio for regime 1
+opt2 <- optimize.portfolio(R[1:(nrow(R)-1)], regime.port,
optimize_method="DEoptim",
search_size=2000,
trace=TRUE)
+opt2
+opt2$regime
# For optimize_method="random", which portfolio do we use and how do we
# generate random portfolios
# - prompt the user to generate random portfolios?
# - use the first portfolio?
# - specify which portfolio?
+# This is important because the constraints may be very different
+# This only impacts optimize.portfolio.rebalancing because we do not know
+# the portfolio specification at the time we generate the random portfolios
opt.rebal <- optimize.portfolio.rebalancing(R, regime.port,
optimize_method="DEoptim",
rebalance_on="quarters",
@@ -53,26 +63,39 @@
search_size=2000,
trace=TRUE)
+# The print and summary methods work the same as they do for optimizations
+# without regime switching
opt.rebal
-
summary(opt.rebal)
+# Get the regime at each rebalance date
lapply(opt.rebal$opt_rebalancing, function(x) x$regime)
# Extract the weights
wt <- extractWeights(opt.rebal)
wt
-# Extract the objective measures
+# Extract the objective measures*
obj <- extractObjectiveMeasures(opt.rebal)
str(obj)
obj
-# Extract the stats
+# Extract the stats*
xt <- extractStats(opt.rebal)
str(xt)
+# *
+# Note that this returns a list of N elements for N regimes. We may have
+# different objectives and/or a different number of objectives which makes
+# returning a single xts object difficult
+
chart.Weights(opt.rebal, colorset=bluemono)
-chart.RiskBudget(opt.rebal, match.col="ES", risk.type="percentage", regime=1, colorset=bluemono)
-chart.RiskBudget(opt.rebal, match.col="StdDev", risk.type="percentage", regime=2, colorset=bluemono)
+# Chart the risk contribution for regime 1
+chart.RiskBudget(opt.rebal, match.col="ES", risk.type="percentage",
+ regime=1, colorset=bluemono)
+
+# Chart the risk contribution for regime 2
+chart.RiskBudget(opt.rebal, match.col="StdDev", risk.type="percentage",
+ regime=2, colorset=bluemono)
+
More information about the Returnanalytics-commits
mailing list