[Returnanalytics-commits] r2241 - in pkg/PerformanceAnalytics/sandbox/Meucci: R data demo

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

Author: mkshah
Date: 2012-08-18 18:40:50 +0200 (Sat, 18 Aug 2012)
New Revision: 2241

Added:
   pkg/PerformanceAnalytics/sandbox/Meucci/data/MeanDiversificationFrontier.rda
   pkg/PerformanceAnalytics/sandbox/Meucci/demo/MeanDiversificationFrontier.R
Modified:
   pkg/PerformanceAnalytics/sandbox/Meucci/R/MeanDiversificationFrontier.R
Log:
Adding demo and data file for MeanDiversificationFrontier.R and editing the core functions

Modified: pkg/PerformanceAnalytics/sandbox/Meucci/R/MeanDiversificationFrontier.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Meucci/R/MeanDiversificationFrontier.R	2012-08-18 01:38:30 UTC (rev 2240)
+++ pkg/PerformanceAnalytics/sandbox/Meucci/R/MeanDiversificationFrontier.R	2012-08-18 16:40:50 UTC (rev 2241)
@@ -23,9 +23,11 @@
   if ( length( A ) == 0 )
   {
     N = nrow( S )
+    L = rep( 0, N )
     K = 0
     tmp = eigen( S )
     E_ = tmp$vectors
+    L_ = diag( tmp$values )
     E = E_
     for ( n in 1:N )
     {
@@ -33,6 +35,39 @@
       L[ n ] = L_[ N - n + 1 , N - n + 1 ]
     }
   }
+  else
+  {
+    K = nrow( A )
+    N = ncol( A )
+    emptyMatrix = matrix( ,nrow = 0, ncol = 0 )
+    E = emptyMatrix
+    B = A
+    for ( n in 1:N - K )
+    {
+      if ( length( E ) != 0 )
+      {
+        B = rbind( A, t( E ) %*% S )
+      }
+      e = GenFirstEigVect( S , B )
+      E = cbind( E , e )
+    }
+     
+    for ( n in N - K + 1:N )
+    {
+      B = t( E ) %*% S
+      e = GenFirstEigVect( S , B )
+      E = cbind( E , e )
+    }
+     
+    # swap order
+    E = cbind( E[ , N - K + 1:N ], E[ , 1:N - K ] )
+  }
+  
+  v = t( E ) %*% S %*% E
+  L = diag( v , nrow = length( v ) )
+
+  G = diag( sqrt( L ), nrow = length( L ) ) %*% solve( E )
+  G = G[ K + 1:N , ]
   return( list( E = E, L = L, G = G ) )
 }
 
@@ -45,19 +80,32 @@
     p = v_ * v_
     R_2 = max( 10^(-10), p / colSums( p ) )
     Minus_Ent = t( R_2 ) * log( R_2 )
-    return( Minus_Ent )
+    
+    # evaluate gradient
+    gradient = rbind( Constr$b - Constr$A %*% x , Constr$beq - Constr$Aeq %*% x )
+    
+    return( list( objective = Minus_Ent , gradient = gradient ) )
   }
-  x = fmincon( @nestedfun , w_0 , Constr.A , Constr.b , Constr.Aeq , Constr.beq )
+  
+  local_opts <- list( algorithm = "NLOPT_LD_SLSQP", xtol_rel = 1.0e-6 , 
+                      check_derivatives = TRUE , check_derivatives_print = "all" , 
+                      eval_f = nestedfun )
+  x = nloptr( x0 = x0 , eval_f = nestedfunC ,
+              opts = list( algorithm = "NLOPT_LD_AUGLAG" , local_opts = local_opts ,
+                print_level = 2 , maxeval = 1000 , 
+                check_derivatives = TRUE , check_derivatives_print = "all" , xtol_rel = 1.0e-6 ) )
   return( x )
 }
 
 MeanTCEntropyFrontier = function( S , Mu , w_b , w_0 , Constr )
 {
+  emptyMatrix = matrix( ,nrow = 0, ncol = 0)
   # compute conditional principal portfolios
   GenPCBasisResult = GenPCBasis( S, emptyMatrix )
 
-  # compute frontier extrema
-  w_MaxExp = linprog( -Mu , Constr.A , Constr.b , Constr.Aeq , Constr.beq )
+  # compute frontier extrema]
+  library( limSolve )
+  w_MaxExp = linp( E = Constr$Aeq , F = Constr$beq , G = -1*Constr$A , H = -1*Constr$b, Cost = -Mu , ispos = FALSE)$X
   MaxExp = t( Mu ) %*% ( w_MaxExp - w_b )
 
   w_MaxNe = MaxEntropy( G , w_b , w_0 , Constr )
@@ -80,8 +128,8 @@
   for ( k in 1:NumPortf )
   {
     ConstR = Constr
-    ConstR.Aeq = cbind( Constr.Aeq, t( Mu ) )
-    ConstR.beq = cbind( Constr.beq, TargetExp[ k ] + t( Mu ) %*% w_b )
+    ConstR$Aeq = cbind( Constr$Aeq, t( Mu ) )
+    ConstR$beq = cbind( Constr$beq, TargetExp[ k ] + t( Mu ) %*% w_b )
 
     w = MaxEntropy( G , w_b , w_0 , ConstR )
 

Added: pkg/PerformanceAnalytics/sandbox/Meucci/data/MeanDiversificationFrontier.rda
===================================================================
(Binary files differ)


Property changes on: pkg/PerformanceAnalytics/sandbox/Meucci/data/MeanDiversificationFrontier.rda
___________________________________________________________________
Added: svn:mime-type
   + application/octet-stream

Added: pkg/PerformanceAnalytics/sandbox/Meucci/demo/MeanDiversificationFrontier.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Meucci/demo/MeanDiversificationFrontier.R	                        (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Meucci/demo/MeanDiversificationFrontier.R	2012-08-18 16:40:50 UTC (rev 2241)
@@ -0,0 +1,33 @@
+# This script computes the mean-diversification efficient frontier
+# see A. Meucci - "Managing Diversification", Risk Magazine, June 2009
+# available at www.ssrn.com
+
+# Code by A. Meucci. This version March 2009. 
+# Last version available at MATLAB central as "Managing Diversification"
+
+# inputs
+# upload returns covariance and expectations
+
+# define benchmark and portfolio weights
+N = nrow( Mu )
+w_0 = rep( 1, N ) / N
+
+# define constraints
+# long-short constraints...
+Constr = list()
+Constr$A = rbind( diag( N ), -diag( N ) )
+Constr$b = rbind( rep( 1, N ), rep( 0.1, N ) )
+Constr$Aeq = rep( 1 , N ) # budget constraint...
+Constr$beq = 1
+
+# mean-diversification analysis and frontier
+EntropyFrontier = MeanTCEntropyFrontier( S , Mu , w_b , w_0 , Constr )
+
+# mean-diversification of current allocation
+m = t( Mu ) %*% ( w_0 - w_b )
+s = sqrt( t( w_0 - w_b ) %*% S %*% ( w_0 - w_b ) )
+GenPCResult = GenPCBasis( S , emptyMatrix )
+v_tilde = G %*% ( w_0 - w_b )
+TE_contr = ( v_tilde * v_tilde ) / s
+R_2 = max( 10^(-10) , TE_contr/sum(TE_contr) )
+Ne = exp( -t( R_2 ) %*% log( R_2 ) )
\ No newline at end of file