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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Aug 17 18:39:52 CEST 2013


Author: rossbennett34
Date: 2013-08-17 18:39:51 +0200 (Sat, 17 Aug 2013)
New Revision: 2806

Modified:
   pkg/PortfolioAnalytics/R/generics.R
Log:
fixing print and summary methods to show better output for objects with risk_budget objectives

Modified: pkg/PortfolioAnalytics/R/generics.R
===================================================================
--- pkg/PortfolioAnalytics/R/generics.R	2013-08-17 14:34:10 UTC (rev 2805)
+++ pkg/PortfolioAnalytics/R/generics.R	2013-08-17 16:39:51 UTC (rev 2806)
@@ -230,14 +230,26 @@
   print.default(object$weights, digits=digits)
   cat("\n")
   
-  # get objective measure
+  # get objective measures
   objective_measures <- object$objective_measures
   tmp_obj <- as.numeric(unlist(objective_measures))
   names(tmp_obj) <- names(objective_measures)
   cat("Objective Measures:\n")
-  for(i in 1:length(tmp_obj)){
-    print(tmp_obj[i], digits=digits)
+  for(i in 1:length(objective_measures)){
+    print(tmp_obj[i], digits=4)
     cat("\n")
+    if(length(objective_measures[[i]]) > 1){
+      # This will be the case for any objective measures with risk budgets
+      for(j in 2:length(objective_measures[[i]])){
+        tmpl <- objective_measures[[i]][j]
+        cat(names(tmpl), ":\n")
+        tmpv <- unlist(tmpl)
+        names(tmpv) <- names(object$weights)
+        print(tmpv)
+        cat("\n")
+      }
+    }
+    cat("\n")
   }
   cat("\n")
 }
@@ -263,14 +275,26 @@
   print.default(object$weights, digits=digits)
   cat("\n")
   
-  # get objective measure
+  # get objective measures
   objective_measures <- object$objective_measures
   tmp_obj <- as.numeric(unlist(objective_measures))
   names(tmp_obj) <- names(objective_measures)
   cat("Objective Measures:\n")
-  for(i in 1:length(tmp_obj)){
-    print(tmp_obj[i], digits=digits)
+  for(i in 1:length(objective_measures)){
+    print(tmp_obj[i], digits=4)
     cat("\n")
+    if(length(objective_measures[[i]]) > 1){
+      # This will be the case for any objective measures with risk budgets
+      for(j in 2:length(objective_measures[[i]])){
+        tmpl <- objective_measures[[i]][j]
+        cat(names(tmpl), ":\n")
+        tmpv <- unlist(tmpl)
+        names(tmpv) <- names(object$weights)
+        print(tmpv)
+        cat("\n")
+      }
+    }
+    cat("\n")
   }
   cat("\n")
 }
@@ -296,14 +320,26 @@
   print.default(object$weights, digits=digits)
   cat("\n")
   
-  # get objective measure
+  # get objective measures
   objective_measures <- object$objective_measures
   tmp_obj <- as.numeric(unlist(objective_measures))
   names(tmp_obj) <- names(objective_measures)
   cat("Objective Measures:\n")
-  for(i in 1:length(tmp_obj)){
-    print(tmp_obj[i], digits=digits)
+  for(i in 1:length(objective_measures)){
+    print(tmp_obj[i], digits=4)
     cat("\n")
+    if(length(objective_measures[[i]]) > 1){
+      # This will be the case for any objective measures with risk budgets
+      for(j in 2:length(objective_measures[[i]])){
+        tmpl <- objective_measures[[i]][j]
+        cat(names(tmpl), ":\n")
+        tmpv <- unlist(tmpl)
+        names(tmpv) <- names(object$weights)
+        print(tmpv)
+        cat("\n")
+      }
+    }
+    cat("\n")
   }
   cat("\n")
 }
@@ -329,15 +365,26 @@
   print.default(object$weights, digits=digits)
   cat("\n")
   
-  # get objective measure
-  # get objective measure
+  # get objective measures
   objective_measures <- object$objective_measures
   tmp_obj <- as.numeric(unlist(objective_measures))
   names(tmp_obj) <- names(objective_measures)
   cat("Objective Measures:\n")
-  for(i in 1:length(tmp_obj)){
-    print(tmp_obj[i], digits=digits)
+  for(i in 1:length(objective_measures)){
+    print(tmp_obj[i], digits=4)
     cat("\n")
+    if(length(objective_measures[[i]]) > 1){
+      # This will be the case for any objective measures with risk budgets
+      for(j in 2:length(objective_measures[[i]])){
+        tmpl <- objective_measures[[i]][j]
+        cat(names(tmpl), ":\n")
+        tmpv <- unlist(tmpl)
+        names(tmpv) <- names(object$weights)
+        print(tmpv)
+        cat("\n")
+      }
+    }
+    cat("\n")
   }
   cat("\n")
 }
@@ -368,13 +415,25 @@
   # The objective measure is object$out for ROI
   cat("Objective Measures:\n")
   if(!is.null(object$objective_measures)){
-    # get objective measure
+    # get objective measures
     objective_measures <- object$objective_measures
     tmp_obj <- as.numeric(unlist(objective_measures))
     names(tmp_obj) <- names(objective_measures)
-    for(i in 1:length(tmp_obj)){
-      print(tmp_obj[i])
+    for(i in 1:length(objective_measures)){
+      print(tmp_obj[i], digits=4)
       cat("\n")
+      if(length(objective_measures[[i]]) > 1){
+        # This will be the case for any objective measures with risk budgets
+        for(j in 2:length(objective_measures[[i]])){
+          tmpl <- objective_measures[[i]][j]
+          cat(names(tmpl), ":\n")
+          tmpv <- unlist(tmpl)
+          names(tmpv) <- names(object$weights)
+          print(tmpv)
+          cat("\n")
+        }
+      }
+      cat("\n")
     }
   } else {
     print(as.numeric(object$out))



More information about the Returnanalytics-commits mailing list