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

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

Author: rossbennett34
Date: 2013-08-27 19:53:00 +0200 (Tue, 27 Aug 2013)
New Revision: 2903

Modified:
   pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
   pkg/PortfolioAnalytics/R/generics.R
Log:
Adding print and summary methods for efficient.frontier objects. Returning the portfolio object for extractEfficientFrontier and create.EfficientFrontier for reproducibility and generic methods.

Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R
===================================================================
--- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R	2013-08-27 16:05:30 UTC (rev 2902)
+++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R	2013-08-27 17:53:00 UTC (rev 2903)
@@ -296,7 +296,7 @@
 create.EfficientFrontier <- function(R, portfolio, type, n.portfolios=25, match.col="ES", search_size=2000, ...){
   # This is just a wrapper around a few functions to easily create efficient frontiers
   # given a portfolio object and other parameters
-  
+  call <- match.call()
   if(!is.portfolio(portfolio)) stop("portfolio must be of class 'portfolio'")
   type <- type[1]
   switch(type,
@@ -334,8 +334,10 @@
                                                              n.portfolios=n.portfolios)
          }
   )
-  return(structure(list(frontier=frontier,
-                        R=R), class="efficient.frontier"))
+  return(structure(list(call=call,
+                        frontier=frontier,
+                        R=R,
+                        portfolio=portfolio), class="efficient.frontier"))
 }
 
 #' Extract the efficient frontier data points
@@ -368,7 +370,7 @@
 #' @export
 extractEfficientFrontier <- function(object, match.col="ES", n.portfolios=25){
   # extract the efficient frontier from an optimize.portfolio output object
-  
+  call <- match.call()
   if(!inherits(object, "optimize.portfolio")) stop("object must be of class 'optimize.portfolio'")
   
   if(inherits(object, "optimize.portfolio.GenSA")){
@@ -400,6 +402,9 @@
   if(inherits(object, c("optimize.portfolio.random", "optimize.portfolio.DEoptim", "optimize.portfolio.pso"))){
     frontier <- extract.efficient.frontier(object=object, match.col=match.col, n.portfolios=n.portfolios)
   }
-  return(frontier)
+  return(structure(list(call=call,
+                        frontier=frontier,
+                        R=R,
+                        portfolio=portfolio), class="efficient.frontier"))
 }
 

Modified: pkg/PortfolioAnalytics/R/generics.R
===================================================================
--- pkg/PortfolioAnalytics/R/generics.R	2013-08-27 16:05:30 UTC (rev 2902)
+++ pkg/PortfolioAnalytics/R/generics.R	2013-08-27 17:53:00 UTC (rev 2903)
@@ -642,3 +642,70 @@
   print(object$elapsed_time)
   cat("\n")
 }
+
+#' Print an efficient frontier object
+#' 
+#' Print method for efficient frontier objects. Display the call to create or
+#' extract the efficient frontier object and the portfolio from which the 
+#' efficient frontier was created or extracted.
+#' 
+#' @param x objective of class \code{efficient.frontier}
+#' @param ... passthrough parameters
+#' @author Ross Bennett
+#' @export
+print.efficient.frontier <- function(x, ...){
+  if(!inherits(x, "efficient.frontier")) stop("object passed in is not of class 'efficient.frontier'")
+  
+  cat(rep("*", 50) ,"\n", sep="")
+  cat("PortfolioAnalytics Efficient Frontier", "\n")
+  cat(rep("*", 50) ,"\n", sep="")
+  
+  cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"), 
+      "\n\n", sep = "")
+  
+  cat("Efficient Frontier Points:", nrow(x$frontier), "\n\n")
+  
+  print(x$portfolio)
+}
+
+#' Summarize an efficient frontier object
+#' 
+#' Summary method for efficient frontier objects. Display the call to create or
+#' extract the efficient frontier object as well as the weights and risk and
+#' return metrics along the efficient frontier.
+#' 
+#' @param x objective of class \code{efficient.frontier}
+#' @param ... passthrough parameters
+#' @author Ross Bennett
+#' @export
+summary.efficient.frontier <- function(object, ..., digits=3){
+  if(!inherits(object, "efficient.frontier")) stop("object passed in is not of class 'efficient.frontier'")
+  
+  cat(rep("*", 50) ,"\n", sep="")
+  cat("PortfolioAnalytics Efficient Frontier", "\n")
+  cat(rep("*", 50) ,"\n", sep="")
+  
+  cat("\nCall:\n", paste(deparse(object$call), sep = "\n", collapse = "\n"), 
+      "\n\n", sep = "")
+  
+  cat("Efficient Frontier Points:", nrow(object$frontier), "\n\n")
+  
+  # Weights
+  cnames <- colnames(object$frontier)
+  wts_idx <- grep(pattern="^w\\.", cnames)
+  wts <- round(object$frontier[, wts_idx], digits=digits)
+  colnames(wts) <- gsub("w.", "", colnames(wts))
+  rownames(wts) <- 1:nrow(object$frontier)
+  cat("Weights along the efficient frontier:\n")
+  print(wts)
+  cat("\n")
+  
+  # Risk and return
+  cat("Risk and return metrics along the efficient frontier:\n")
+  riskret <- object$frontier[, -wts_idx]
+  rownames(riskret) <- 1:nrow(object$frontier)
+  print(round(riskret, digits=digits))
+  cat("\n")
+  invisible(list(weights=wts, metrics=riskret))
+}
+