[Returnanalytics-commits] r3223 - pkg/PortfolioAnalytics/R

[noreply at r-forge.r-project.org]

Author: rossbennett34
Date: 2013-10-17 18:48:38 +0200 (Thu, 17 Oct 2013)
New Revision: 3223

Modified:
   pkg/PortfolioAnalytics/R/equal.weight.R
   pkg/PortfolioAnalytics/R/extractstats.R
   pkg/PortfolioAnalytics/R/inverse.volatility.weight.R
Log:
Minor modification to equal weight and inverse volatility weight constructors. Added extractStats method for optimize.portfolio.eqwt and optimize.portfolio.invol.

Modified: pkg/PortfolioAnalytics/R/equal.weight.R
===================================================================
--- pkg/PortfolioAnalytics/R/equal.weight.R	2013-10-17 16:30:37 UTC (rev 3222)
+++ pkg/PortfolioAnalytics/R/equal.weight.R	2013-10-17 16:48:38 UTC (rev 3223)
@@ -36,11 +36,12 @@
     }
   }
   
-  out <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...)$objective_measures
+  tmpout <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...)
   return(structure(list(
     R=R,
     weights=weights,
-    objective_measures=out,
+    out=tmpout$out,
+    objective_measures=tmpout$objective_measures,
     call=match.call(),
     portfolio=portfolio),
                    class=c("optimize.portfolio.eqwt", "optimize.portfolio"))

Modified: pkg/PortfolioAnalytics/R/extractstats.R
===================================================================
--- pkg/PortfolioAnalytics/R/extractstats.R	2013-10-17 16:30:37 UTC (rev 3222)
+++ pkg/PortfolioAnalytics/R/extractstats.R	2013-10-17 16:48:38 UTC (rev 3223)
@@ -297,6 +297,36 @@
   return(result)
 }
 
+#' @method extractStats optimize.portfolio.invol
+#' @S3method extractStats optimize.portfolio.invol
+#' @export 
+extractStats.optimize.portfolio.invol <- function(object, prefix=NULL, ...) {
+  if(!inherits(object, "optimize.portfolio.invol")) stop("object must be of class optimize.portfolio.invol")
+  trow<-c(out=object$out, object$weights)
+  
+  obj <- unlist(object$objective_measures)
+  result <- c(obj, trow)
+  
+  rnames <- name.replace(names(result))
+  names(result) <- rnames
+  return(result)
+}
+
+#' @method extractStats optimize.portfolio.eqwt
+#' @S3method extractStats optimize.portfolio.eqwt
+#' @export 
+extractStats.optimize.portfolio.eqwt <- function(object, prefix=NULL, ...) {
+  if(!inherits(object, "optimize.portfolio.eqwt")) stop("object must be of class optimize.portfolio.eqwt")
+  trow<-c(out=object$out, object$weights)
+  
+  obj <- unlist(object$objective_measures)
+  result <- c(obj, trow)
+  
+  rnames <- name.replace(names(result))
+  names(result) <- rnames
+  return(result)
+}
+
 #' Extract the objective measures
 #' 
 #' This function will extract the objective measures from the optimal portfolio

Modified: pkg/PortfolioAnalytics/R/inverse.volatility.weight.R
===================================================================
--- pkg/PortfolioAnalytics/R/inverse.volatility.weight.R	2013-10-17 16:30:37 UTC (rev 3222)
+++ pkg/PortfolioAnalytics/R/inverse.volatility.weight.R	2013-10-17 16:48:38 UTC (rev 3223)
@@ -37,11 +37,12 @@
   weights <- as.vector((1/StdDev(R))/sum(1/StdDev(R)))
   names(weights) <- names(assets)
   
-  out <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...)$objective_measures
+  tmpout <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...)
   return(structure(list(
     R=R,
     weights=weights,
-    objective_measures=out,
+    out=tmpout$out,
+    objective_measures=tmpout$objective_measures,
     call=match.call(),
     portfolio=portfolio),
                    class=c("optimize.portfolio.invol", "optimize.portfolio"))