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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Aug 5 20:16:38 CEST 2014


Author: rossbennett34
Date: 2014-08-05 20:16:38 +0200 (Tue, 05 Aug 2014)
New Revision: 3500

Modified:
   pkg/PortfolioAnalytics/R/generics.R
Log:
revised summary method for portfolio objects

Modified: pkg/PortfolioAnalytics/R/generics.R
===================================================================
--- pkg/PortfolioAnalytics/R/generics.R	2014-08-05 18:10:52 UTC (rev 3499)
+++ pkg/PortfolioAnalytics/R/generics.R	2014-08-05 18:16:38 UTC (rev 3500)
@@ -296,47 +296,43 @@
 #' @method summary portfolio
 #' @export
 summary.portfolio <- function(object, ...){
-  if(!is.portfolio(object)) stop("object passed in is not of class 'portfolio'")
+  if(!is.portfolio(x)) stop("object passed in is not of class 'portfolio'")
   
-  cat(rep("*", 50) ,"\n", sep="")
-  cat("PortfolioAnalytics Portfolio Specification Summary", "\n")
-  cat(rep("*", 50) ,"\n", sep="")
+  out <- list()
   
-  cat("Assets and Initial Weights:\n")
-  print(object$assets)
-  cat("\n")
+  out$category_labels <- object$category_labels
+  out$weight_seq <- object$weight_seq
+  out$assets <- object$assets
   
-  if(!is.null(object$category_labels)) {
-    cat("Category Labels:\n")
-    print(object$category_labels)
-  }
-  
-  if(!is.null(object$weight_seq)) {
-    cat("weight_seq:\n")
-    print(summary(object$weight_seq))
-  }
-  
-  cat("Constraints:\n\n")
-  for(constraint in object$constraints){
-    if(constraint$enabled) {
-      cat(rep("*", 40), "\n", sep="")
-      cat(constraint$type, "constraint\n")
-      cat(rep("*", 40), "\n", sep="")
-      print(constraint)
-      cat("\n\n")
+  # constraints
+  out$enabled_constraints <- list()
+  out$disabled_constraints <- list()
+  constraints <- object$constraints
+  for(i in 1:length(constraints)){
+    if(constraints[[i]]$enabled){
+      tmp <- length(out$enabled_constraints)
+      out$enabled_constraints[[tmp+1]] <- constraints[[i]]
+    } else {
+      tmp <- length(out$disabled_constraints)
+      out$disabled_constraints[[tmp+1]] <- constraints[[i]]
     }
   }
   
-  cat("Objectives:\n\n")
-  for(objective in object$objectives){
-    if(objective$enabled) {
-      cat(rep("*", 40), "\n", sep="")
-      cat(class(objective)[1], "\n")
-      cat(rep("*", 40), "\n", sep="")
-      print(objective)
-      cat("\n\n")
+  # objectives
+  out$enabled_objectives <- list()
+  out$disabled_objectives <- list()
+  objectives <- object$objectives
+  for(i in 1:length(objectives)){
+    if(objectives[[i]]$enabled){
+      tmp <- length(out$enabled_objectives)
+      out$enabled_objectives[[tmp+1]] <- objectives[[i]]
+    } else {
+      tmp <- length(out$disabled_objectives)
+      out$disabled_objectives[[tmp+1]] <- objectives[[i]]
     }
   }
+  class(out) <- "summary.portfolio"
+  return(out)
 }
 
 #' print method for constraint objects



More information about the Returnanalytics-commits mailing list