[Returnanalytics-commits] r2537 - in pkg/PortfolioAnalytics: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 11 04:34:00 CEST 2013
Author: rossbennett34
Date: 2013-07-11 04:33:59 +0200 (Thu, 11 Jul 2013)
New Revision: 2537
Added:
pkg/PortfolioAnalytics/man/set.portfolio.moments_v2.Rd
Modified:
pkg/PortfolioAnalytics/NAMESPACE
pkg/PortfolioAnalytics/R/moment.functions.R
pkg/PortfolioAnalytics/R/optimize.portfolio.R
Log:
added set.portfolio.moments_v2 to accept a portfolio object.
Modified: pkg/PortfolioAnalytics/NAMESPACE
===================================================================
--- pkg/PortfolioAnalytics/NAMESPACE 2013-07-10 14:05:20 UTC (rev 2536)
+++ pkg/PortfolioAnalytics/NAMESPACE 2013-07-11 02:33:59 UTC (rev 2537)
@@ -48,6 +48,7 @@
export(return_objective)
export(risk_budget_objective)
export(rp_transform)
+export(set.portfolio.moments_v2)
export(set.portfolio.moments)
export(summary.optimize.portfolio.rebalancing)
export(summary.portfolio)
Modified: pkg/PortfolioAnalytics/R/moment.functions.R
===================================================================
--- pkg/PortfolioAnalytics/R/moment.functions.R 2013-07-10 14:05:20 UTC (rev 2536)
+++ pkg/PortfolioAnalytics/R/moment.functions.R 2013-07-11 02:33:59 UTC (rev 2537)
@@ -141,6 +141,89 @@
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
+#' @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")
+ next()
+ } else {
+
+ # How would this be specified in the new portfolio.spec? As a constraint or in the portfolio part?
+ #
+ 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,...)
+ }
+ }
+ }
+ }
+
+
+ lcl<-grep('clean',portfolio)
+ if(!identical(lcl,integer(0))) {
+ for (objective in portfolio[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 portfolio$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)
+}
+
garch.mm <- function(R,mu_ts, covlist,momentargs=list(),...) {
#momentargs<-list()
#momentargs$mu<-mu_ts[last(index(R)),]
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-10 14:05:20 UTC (rev 2536)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-07-11 02:33:59 UTC (rev 2537)
@@ -465,6 +465,58 @@
return(out)
}
+##### version 2 of optimize.portfolio #####
+optimize.portfolio_v2 <- function(
+ R,
+ portfolio,
+ optimize_method=c("DEoptim","random","ROI","ROI_old","pso","GenSA"),
+ search_size=20000,
+ trace=FALSE, ...,
+ rp=NULL,
+ momentFUN='set.portfolio.moments_v2'
+)
+{
+ optimize_method=optimize_method[1]
+ tmptrace=NULL
+ start_t<-Sys.time()
+
+ #store the call for later
+ call <- match.call()
+
+ if (is.null(portfolio) | !is.portfolio(portfolio)){
+ stop("you must pass in an object of class portfolio to control the optimization")
+ }
+
+ R <- checkData(R)
+ N <- length(portfolio$assets)
+ if (ncol(R) > N) {
+ R <- R[,names(portfolio$assets)]
+ }
+ T <- nrow(R)
+
+ out <- list()
+
+ weights <- NULL
+
+ dotargs <- list(...)
+
+ # set portfolio moments only once
+ if(!is.function(momentFUN)){
+ momentFUN <- match.fun(momentFUN)
+ }
+ # TODO FIXME should match formals later
+ #dotargs <- set.portfolio.moments(R, constraints, momentargs=dotargs)
+ .mformals <- dotargs
+ .mformals$R <- R
+ .mformals$portfolio <- portfolio
+ mout <- try((do.call(momentFUN,.mformals)) ,silent=TRUE)
+ if(inherits(mout,"try-error")) {
+ message(paste("portfolio moment function failed with message",mout))
+ } else {
+ dotargs <- mout
+ }
+}
+
#' portfolio optimization with support for rebalancing or rolling periods
#'
#' This function may eventually be wrapped into optimize.portfolio
Added: pkg/PortfolioAnalytics/man/set.portfolio.moments_v2.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/set.portfolio.moments_v2.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/set.portfolio.moments_v2.Rd 2013-07-11 02:33:59 UTC (rev 2537)
@@ -0,0 +1,25 @@
+\name{set.portfolio.moments_v2}
+\alias{set.portfolio.moments_v2}
+\title{set portfolio moments for use by lower level optimization functions}
+\usage{
+ set.portfolio.moments_v2(R, portfolio, momentargs = NULL,
+ ...)
+}
+\arguments{
+ \item{R}{an xts, vector, matrix, data frame, timeSeries
+ or zoo object of asset returns}
+
+ \item{portfolio}{an object of type "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{\dots}{any other passthru parameters}
+}
+\description{
+ set portfolio moments for use by lower level optimization
+ functions
+}
+
More information about the Returnanalytics-commits
mailing list