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

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

Author: rossbennett34
Date: 2014-05-24 06:12:35 +0200 (Sat, 24 May 2014)
New Revision: 3392

Modified:
   pkg/PortfolioAnalytics/R/moment.functions.R
   pkg/PortfolioAnalytics/R/optFUN.R
   pkg/PortfolioAnalytics/R/optimize.portfolio.R
Log:
Some minor tweaks to improve performance for optimization with ROI method

Modified: pkg/PortfolioAnalytics/R/moment.functions.R
===================================================================
--- pkg/PortfolioAnalytics/R/moment.functions.R	2014-05-23 14:31:44 UTC (rev 3391)
+++ pkg/PortfolioAnalytics/R/moment.functions.R	2014-05-24 04:12:35 UTC (rev 3392)
@@ -200,12 +200,12 @@
              mean = {
                if(is.null(momentargs$mu)) momentargs$mu = matrix( as.vector(apply(R,2,'mean', na.rm=TRUE)),ncol=1)
                },
+             var =,
              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);

Modified: pkg/PortfolioAnalytics/R/optFUN.R
===================================================================
--- pkg/PortfolioAnalytics/R/optFUN.R	2014-05-23 14:31:44 UTC (rev 3391)
+++ pkg/PortfolioAnalytics/R/optFUN.R	2014-05-24 04:12:35 UTC (rev 3392)
@@ -149,11 +149,13 @@
     port.mean <- as.numeric(sum(weights * moments$mean))
     names(port.mean) <- "mean"
     obj_vals[["mean"]] <- port.mean
-    port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights))
+    # faster and more efficient way to compute t(w) %*% Sigma %*% w
+    port.sd <- sqrt(sum(crossprod(weights, moments$var) * weights))
     names(port.sd) <- "StdDev"
     obj_vals[["StdDev"]] <- port.sd
   } else {
-    port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights))
+    # faster and more efficient way to compute t(w) %*% Sigma %*% w
+    port.sd <- sqrt(sum(crossprod(weights, moments$var) * weights))
     names(port.sd) <- "StdDev"
     obj_vals[["StdDev"]] <- port.sd
   }
@@ -798,11 +800,13 @@
     port.mean <- as.numeric(sum(weights * moments$mean))
     names(port.mean) <- "mean"
     obj_vals[["mean"]] <- port.mean
-    port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights))
+    # faster and more efficient way to compute t(w) %*% Sigma %*% w
+    port.sd <- sqrt(sum(crossprod(weights, moments$var) * weights))
     names(port.sd) <- "StdDev"
     obj_vals[["StdDev"]] <- port.sd
   } else {
-    port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights))
+    # faster and more efficient way to compute t(w) %*% Sigma %*% w
+    port.sd <- sqrt(sum(crossprod(weights, moments$var) * weights))
     names(port.sd) <- "StdDev"
     obj_vals[["StdDev"]] <- port.sd
   }
@@ -947,11 +951,13 @@
     port.mean <- as.numeric(sum(weights * moments$mean))
     names(port.mean) <- "mean"
     obj_vals[["mean"]] <- port.mean
-    port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights))
+    # faster and more efficient way to compute t(w) %*% Sigma %*% w
+    port.sd <- sqrt(sum(crossprod(weights, moments$var) * weights))
     names(port.sd) <- "StdDev"
     obj_vals[["StdDev"]] <- port.sd
   } else {
-    port.sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights))
+    # faster and more efficient way to compute t(w) %*% Sigma %*% w
+    port.sd <- sqrt(sum(crossprod(weights, moments$var) * weights))
     names(port.sd) <- "StdDev"
     obj_vals[["StdDev"]] <- port.sd
   }
@@ -1009,7 +1015,7 @@
                    control=control)
   }
   weights <- matrix(opt$weights, ncol=1)
-  opt_mean <- as.numeric(t(weights) %*% matrix(moments$mean, ncol=1))
+  opt_mean <- sum(weights * moments$mean)
   opt_etl <- as.numeric(opt$out)
   starr <- opt_mean / opt_etl
   return(starr)
@@ -1153,8 +1159,11 @@
                  target=target_return, lambda_hhi=lambda_hhi,
                  conc_groups=conc_groups, solver=solver, control=control)
   weights <- opt$weights
-  opt_mean <- as.numeric(t(weights) %*% matrix(moments$mean, ncol=1))
-  opt_sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights))
+  # opt_mean <- as.numeric(t(weights) %*% matrix(moments$mean, ncol=1))
+  opt_mean <- sum(weights * moments$mean)
+  # opt_sd <- as.numeric(sqrt(t(weights) %*% moments$var %*% weights))
+  # faster and more efficient way to compute t(w) %*% Sigma %*% w
+  opt_sd <- sqrt(sum(crossprod(weights, moments$var) * weights))
   opt_sr <- opt_mean / opt_sd
   return(opt_sr)
 }

Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R	2014-05-23 14:31:44 UTC (rev 3391)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R	2014-05-24 04:12:35 UTC (rev 3392)
@@ -938,7 +938,7 @@
         # obj_vals <- roi_result$obj_vals
         # calculate obj_vals based on solver output
         obj_vals <- list()
-        if(meanetl) obj_vals$mean <- as.numeric(t(weights) %*% moments$mean)
+        if(meanetl) obj_vals$mean <- sum(weights * moments$mean)
         obj_vals[[tmpnames[idx]]] <- roi_result$out
         out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call)
       } else {
@@ -948,7 +948,7 @@
         # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures
         # obj_vals <- roi_result$obj_vals
         obj_vals <- list()
-        if(meanetl) obj_vals$mean <- as.numeric(t(weights) %*% moments$mean)
+        if(meanetl) obj_vals$mean <- sum(weights * moments$mean)
         obj_vals[[tmpnames[idx]]] <- roi_result$out
         out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call)
       }