[Returnanalytics-commits] r3396 - in pkg/PortfolioAnalytics: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 27 22:52:44 CEST 2014
Author: rossbennett34
Date: 2014-05-27 22:52:44 +0200 (Tue, 27 May 2014)
New Revision: 3396
Added:
pkg/PortfolioAnalytics/man/regime.portfolios.Rd
Modified:
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/extractstats.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/R/portfolio.R
Log:
Adding support for regime switching
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2014-05-27 06:01:39 UTC (rev 3395)
+++ pkg/PortfolioAnalytics/NAMESPACE 2014-05-27 20:52:44 UTC (rev 3396)
@@ -57,6 +57,7 @@
export(randomize_portfolio_v1)
export(randomize_portfolio_v2)
export(randomize_portfolio)
+export(regime.portfolios)
export(return_constraint)
export(return_objective)
export(risk_budget_objective)
Modified: pkg/PortfolioAnalytics/R/extractstats.R
===================================================================
--- pkg/PortfolioAnalytics/R/extractstats.R 2014-05-27 06:01:39 UTC (rev 3395)
+++ pkg/PortfolioAnalytics/R/extractstats.R 2014-05-27 20:52:44 UTC (rev 3396)
@@ -387,21 +387,58 @@
extractObjectiveMeasures.optimize.portfolio.rebalancing <- function(object){
if(!inherits(object, "optimize.portfolio.rebalancing")) stop("object must be of class 'optimize.portfolio.rebalancing'")
- rebal_object <- object$opt_rebal
+ if(inherits(opt.rebal$portfolio, "regime.portfolios")){
+ result <- extractObjRegime(object)
+ } else {
+ rebal_object <- object$opt_rebal
+ num.columns <- length(unlist(extractObjectiveMeasures(rebal_object[[1]])))
+ num.rows <- length(rebal_object)
+ result <- matrix(nrow=num.rows, ncol=num.columns)
+ for(i in 1:num.rows){
+ result[i,] <- unlist(extractObjectiveMeasures(rebal_object[[i]]))
+ }
+ colnames(result) <- name.replace(names(unlist(extractObjectiveMeasures(rebal_object[[1]]))))
+ rownames(result) <- names(rebal_object)
+ result <- as.xts(result)
+ }
+ return(result)
+}
+
+# Helper function for extractObjectiveMeasures.optimize.portfolio.rebalancing
+# with regime switching.
+# If I have N different regimes and N different portfolios, then
+# extractObjectiveMeasures should return a list of length N where each element
+# contains the objective measures for a given regime
+extractObjRegime <- function(object){
+ tmp.regimes <- unlist(lapply(object$opt_rebalancing, function(x) x$regime))
+ unique.regimes <- unique(tmp.regimes)
- num.columns <- length(unlist(extractObjectiveMeasures(rebal_object[[1]])))
- num.rows <- length(rebal_object)
+ # Initialize a list to hold the objective measures for each regime
+ out.list <- vector("list", length(unique.regimes))
+ names(out.list) <- paste("regime", 1:length(unique.regimes), sep=".")
- result <- matrix(nrow=num.rows, ncol=num.columns)
-
- for(i in 1:num.rows){
- result[i,] <- unlist(extractObjectiveMeasures(rebal_object[[i]]))
+ # Outer loop over each regime
+ for(i in 1:length(unique.regimes)){
+ # Get the index for each regime
+ tmp.idx <- which(tmp.regimes == unique.regimes[i])
+
+ # Initialize a temporary list to store the objective measures for each
+ # unique regime
+ tmp <- vector("list", length(tmp.idx))
+
+ # Nested loop over each optimize.portfolio object of the corresoponding regime
+ for(j in 1:length(tmp)){
+ tmp[[j]] <- unlist(object$opt_rebalancing[[tmp.idx[j]]]$objective_measures)
+ }
+ # rbind the objective measures and convert to an xts object
+ #obj <- xts(do.call(rbind, tmp), as.Date(names(tmp.idx)))
+ obj <- do.call(rbind, tmp)
+ colnames(obj) <- PortfolioAnalytics:::name.replace(colnames(obj))
+ obj <- xts(obj, as.Date(names(tmp.idx)))
+ # insert the objective measures into the list
+ out.list[[i]] <- obj
}
-
- colnames(result) <- name.replace(names(unlist(extractObjectiveMeasures(rebal_object[[1]]))))
- rownames(result) <- names(rebal_object)
- result <- as.xts(result)
- return(result)
+ out.list
}
#' @method extractObjectiveMeasures summary.optimize.portfolio.rebalancing
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-05-27 06:01:39 UTC (rev 3395)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2014-05-27 20:52:44 UTC (rev 3396)
@@ -476,6 +476,23 @@
return(out)
}
+ # Detect regime switching portfolio
+ if(inherits(portfolio, "regime.portfolios")){
+ regime.switching <- TRUE
+ regime <- portfolio$regime
+ if(index(last(R)) %in% index(regime)){
+ regime.idx <- as.numeric(regime[index(last(R))])[1]
+ portfolio <- portfolio$portfolio.list[[regime.idx]]
+ #cat("regime: ", regime.idx, "\n")
+ } else {
+ warning("Dates in regime and R do not match, defaulting to first portfolio")
+ regime.idx <- 1
+ portfolio <- portfolio$portfolio.list[[regime.idx]]
+ }
+ } else {
+ regime.switching <- FALSE
+ }
+
optimize_method <- optimize_method[1]
tmptrace <- NULL
start_t <- Sys.time()
@@ -515,6 +532,7 @@
}
T <- nrow(R)
+ # Initialize an empty list used as the return object
out <- list()
weights <- NULL
@@ -1072,6 +1090,12 @@
out$data_summary <- list(first=first(R), last=last(R))
out$elapsed_time <- end_t - start_t
out$end_t <- as.character(Sys.time())
+ # return a $regime element to indicate what regime portfolio used for
+ # optimize.portfolio. The regime information is used in extractStats and
+ # extractObjectiveMeasures
+ if(regime.switching){
+ out$regime <- regime.idx
+ }
class(out) <- c(paste("optimize.portfolio", optimize_method, sep='.'), "optimize.portfolio")
return(out)
}
Modified: pkg/PortfolioAnalytics/R/portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/portfolio.R 2014-05-27 06:01:39 UTC (rev 3395)
+++ pkg/PortfolioAnalytics/R/portfolio.R 2014-05-27 20:52:44 UTC (rev 3396)
@@ -118,4 +118,39 @@
#' @export
is.portfolio <- function( x ) {
inherits( x, "portfolio" )
-}
\ No newline at end of file
+}
+
+#' Regime Portfolios
+#'
+#' Construct a \code{regime.portfolios} object that contains a time series of
+#' regimes and portfolios corresponding to the regimes.
+#'
+#' Create a \code{regime.portfolios} object to support regime switching
+#' optimization. This object is then passed in as the \code{portfolio}
+#' argument in \code{optimize.portfolio}. The regime is detected and the
+#' corresponding portfolio is selected. For example, if the current
+#' regime is 1, then portfolio 1 will be selected and used in the
+#' optimization.
+#'
+#' @param regime xts or zoo object specifying the regime
+#' @param portfolios list of portfolios created by
+#' \code{combine.portfolios} with corresponding regimes
+#' @return a \code{regime.portfolios} object with the following elements
+#' \itemize{
+#' \item{regime: }{An xts object of the regime}
+#' \item{portfolio: }{List of portfolios corresponding to the regime}
+#' }
+#' @author Ross Bennett
+#' @export
+regime.portfolios <- function(regime, portfolios){
+ if(!inherits(regime, c("xts", "zoo"))) stop("regime object must be an xts or zoo object")
+ if(!inherits(portfolios, "portfolio.list")) stop("portfolios object must be a portfolio.list object")
+
+ n.regimes <- length(unique(regime))
+ n.portfolios <- length(portfolios)
+ if(n.regimes != n.portfolios) stop("Number of portfolios must match the number of regimes")
+
+ # structure and return
+ return(structure(list(regime=regime, portfolio.list=portfolios),
+ class=c("regime.portfolios", "portfolio")))
+}
Added: pkg/PortfolioAnalytics/man/regime.portfolios.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/regime.portfolios.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/regime.portfolios.Rd 2014-05-27 20:52:44 UTC (rev 3396)
@@ -0,0 +1,36 @@
+\name{regime.portfolios}
+\alias{regime.portfolios}
+\title{Regime Portfolios}
+\usage{
+ regime.portfolios(regime, portfolios)
+}
+\arguments{
+ \item{regime}{xts or zoo object specifying the regime}
+
+ \item{portfolios}{list of portfolios created by
+ \code{combine.portfolios} with corresponding regimes}
+}
+\value{
+ a \code{regime.portfolios} object with the following
+ elements \itemize{ \item{regime: }{An xts object of the
+ regime} \item{portfolio: }{List of portfolios
+ corresponding to the regime} }
+}
+\description{
+ Construct a \code{regime.portfolios} object that contains
+ a time series of regimes and portfolios corresponding to
+ the regimes.
+}
+\details{
+ Create a \code{regime.portfolios} object to support
+ regime switching optimization. This object is then passed
+ in as the \code{portfolio} argument in
+ \code{optimize.portfolio}. The regime is detected and the
+ corresponding portfolio is selected. For example, if the
+ current regime is 1, then portfolio 1 will be selected
+ and used in the optimization.
+}
+\author{
+ Ross Bennett
+}
+
More information about the Returnanalytics-commits
mailing list