[Returnanalytics-commits] r2421 - in pkg/Meucci: . R demo

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jun 24 23:14:39 CEST 2013


Author: xavierv
Date: 2013-06-24 23:14:39 +0200 (Mon, 24 Jun 2013)
New Revision: 2421

Added:
   pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R
   pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R
   pkg/Meucci/demo/S_WishartCorrelation.R
Modified:
   pkg/Meucci/DESCRIPTION
   pkg/Meucci/R/logToArithmeticCovariance.R
   pkg/Meucci/demo/S_BivariateSample.R
   pkg/Meucci/demo/S_FxCopulaMarginal.R
   pkg/Meucci/demo/S_LognormalSample.R
Log:
- added three new demo files from chapter 2 and error fixing

Modified: pkg/Meucci/DESCRIPTION
===================================================================
--- pkg/Meucci/DESCRIPTION	2013-06-24 19:54:05 UTC (rev 2420)
+++ pkg/Meucci/DESCRIPTION	2013-06-24 21:14:39 UTC (rev 2421)
@@ -43,7 +43,9 @@
     nloptr,
     ggplot2,
     expm,
-    latticeExtra
+    latticeExtra,
+    scatterplot3d,
+    psych
 License: GPL
 URL: http://r-forge.r-project.org/projects/returnanalytics/
 Copyright: (c) 2012

Modified: pkg/Meucci/R/logToArithmeticCovariance.R
===================================================================
--- pkg/Meucci/R/logToArithmeticCovariance.R	2013-06-24 19:54:05 UTC (rev 2420)
+++ pkg/Meucci/R/logToArithmeticCovariance.R	2013-06-24 21:14:39 UTC (rev 2421)
@@ -14,6 +14,7 @@
 #' # formula (7) and (8) on page 5 of Appendix to "Meucci - A Common Pitfall in Mean-Variance Estimation"
 #' \url{http://www.wilmott.com/pdfs/011119_meucci.pdf}
 #' @export
+
 linreturn <- function( mu , sigma )
 {   
     # each element of M represents the linear returns for the corresponding log-returns element in mu

Modified: pkg/Meucci/demo/S_BivariateSample.R
===================================================================
--- pkg/Meucci/demo/S_BivariateSample.R	2013-06-24 19:54:05 UTC (rev 2420)
+++ pkg/Meucci/demo/S_BivariateSample.R	2013-06-24 21:14:39 UTC (rev 2421)
@@ -56,7 +56,7 @@
 # 3d histograms 
 
 NumBins2D = round(sqrt(100 * log(nSim)));
-Z_3 = table( cut (Z_1, NumBins2D ), cut ( Z_2, cloud ));
+Z_3 = table( cut (Z_1, NumBins2D ), cut ( Z_2, NumBins2D));
 
 cloud( Z_3, panel.3d.cloud = panel.3dbars, scales = list( arrows = FALSE, just = "right" ), 
 	xlab = "normal 1", ylab = "normal 2", zlab="", main = "pdf normal" );

Modified: pkg/Meucci/demo/S_FxCopulaMarginal.R
===================================================================
--- pkg/Meucci/demo/S_FxCopulaMarginal.R	2013-06-24 19:54:05 UTC (rev 2420)
+++ pkg/Meucci/demo/S_FxCopulaMarginal.R	2013-06-24 21:14:39 UTC (rev 2421)
@@ -48,12 +48,15 @@
 # marginals
 NumBins = round(10 * log(NumObs));
 
+layout( matrix(c(1,2,2,1,2,2,0,3,3), 3, 3, byrow = TRUE), heights=c(1,2,1));
 
-layout( matrix(c(1,2,3), 3, 1, byrow = TRUE), heights=c(1,2,1));
 
 
-hist( X[ , Display[ 2 ] ], NumBins, xlab = db_FX$Fields[[ Display[ 2 ] + 1 ]], ylab = "", main = "");
+#hist( X[ , Display[ 2 ] ], NumBins, xlab = db_FX$Fields[[ Display[ 2 ] + 1 ]], ylab = "", main = "");
+barplot( table( cut( X[ , Display[ 2 ] ], NumBins )), horiz=TRUE, yaxt="n")
+axis( 2, at = seq(0, 100, 20), labels = seq( 0, 1, 0.2 ) );
 
+
 # scatter plot
 plot( Copula[ , Display[ 1 ] ], Copula[ , Display[ 2 ] ], main = "Copula", 
 	xlab = db_FX$Fields[[ Display[ 2 ] + 1 ]], ylab = db_FX$Fields[[ Display[ 1 ] + 1 ]] );

Modified: pkg/Meucci/demo/S_LognormalSample.R
===================================================================
--- pkg/Meucci/demo/S_LognormalSample.R	2013-06-24 19:54:05 UTC (rev 2420)
+++ pkg/Meucci/demo/S_LognormalSample.R	2013-06-24 21:14:39 UTC (rev 2421)
@@ -8,8 +8,8 @@
 #' @author Xavier Valls \email{flamejat@@gmail.com}
 #' @export
 
+source("../R/LognormalMoments2Parameters.R");
 
-
 ##################################################################################################################
 ### Input parameters
 

Added: pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R
===================================================================
--- pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R	                        (rev 0)
+++ pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R	2013-06-24 21:14:39 UTC (rev 2421)
@@ -0,0 +1,40 @@
+library(scatterplot3d);
+
+#' This script script shows that the pdf of the r-th order statistics of a lognormal random variable,
+#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005,  Chapter 2.
+#'
+#' @references
+#' \url{http://}
+#' See Meucci's script for "S_OrderStatisticsPdfLognormal.m"
+#'
+#' @author Xavier Valls \email{flamejat@@gmail.com}
+#' @export
+
+#################################################################################################################
+### Input  
+
+mu = 0.2;
+s  = 0.25;
+T  = 70;
+
+#################################################################################################################
+### Pdf of r-th order statistic concentrated around the r/T quantile
+
+rs = 1 : T;
+x  = seq( 0 , 2.5 * exp(mu + s * s / 2), 0.01 );
+
+F = plnorm( x, mu, s );
+f = dlnorm( x, mu, s );
+
+#matrix to plot
+
+a = scatterplot3d( 0,  0 , 0, xlim=c(0,4), ylim=c(0,1), zlim=c(0,10), xlab = "x", ylab = "r/T", zlab = "pdf" );
+
+for ( n in 1 : length( rs ) )
+{
+    r = rs[ n ];    
+    pdf_rT = gamma( T + 1 ) / ( gamma( r ) * gamma( T - r + 1 )) * ( F ^ (r - 1) ) * (( 1 - F ) ^ ( T - r) ) * f;
+    q = qlnorm( r / T, mu, s );
+    a$points3d( x, r / T + 0 * x, pdf_rT );
+    a$points3d( q, r / T, 0 );
+}
\ No newline at end of file

Added: pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R
===================================================================
--- pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R	                        (rev 0)
+++ pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R	2013-06-24 21:14:39 UTC (rev 2421)
@@ -0,0 +1,38 @@
+library(scatterplot3d);
+
+#' This script script shows that the pdf of the r-th order statistics of a tudent t random variable,
+#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005,  Chapter 2.
+#'
+#' @references
+#' \url{http://}
+#' See Meucci's script for "S_OrderStatisticsPdfLognormal.m"
+#'
+#' @author Xavier Valls \email{flamejat@@gmail.com}
+#' @export
+
+#################################################################################################################
+### Input  
+mu = 0;
+s  = 1;
+nu = 10;
+T  = 70;
+
+#################################################################################################################
+### Pdf of r-th order statistic concentrated around the r/T quantile
+
+rs = 1: T;
+x = mu + s * seq( -4, 4, 0.01);
+
+F = pt((x - mu) / s, nu);
+f = 1 / s * dt((x - mu) / s, nu);
+
+a = scatterplot3d( 0,  0 , 0, xlim = c(-4 , 4 ), ylim = c( 0, 1 ), zlim = c( 0, 3), xlab = "x", ylab = "r/T", zlab = "pdf" );
+
+for ( n in 1 : length( rs ) )
+{
+    r = rs[ n ];    
+    pdf_rT = gamma( T + 1 ) / ( gamma( r ) * gamma( T - r + 1 )) * ( F ^ (r - 1) ) * (( 1 - F ) ^ ( T - r) ) * f;
+    q = mu + s * qt( r / T, nu );
+    a$points3d( x, r / T + 0 * x, pdf_rT, type = "l" );
+    a$points3d( q, r / T, 0 );
+}
\ No newline at end of file

Added: pkg/Meucci/demo/S_WishartCorrelation.R
===================================================================
--- pkg/Meucci/demo/S_WishartCorrelation.R	                        (rev 0)
+++ pkg/Meucci/demo/S_WishartCorrelation.R	2013-06-24 21:14:39 UTC (rev 2421)
@@ -0,0 +1,58 @@
+#' This script computes the correlation of the first diagonal and off-diagonal elements 
+#' of a 2x2 Wishart distribution as a function of the inputs, as described in A. Meucci,
+#' "Risk and Asset Allocation", Springer, 2005,  Chapter 2.
+#'
+#' @references
+#' \url{http://}
+#' See Meucci's script for "S_WishartCorrelation.m"
+#'
+#' @author Xavier Valls \email{flamejat@@gmail.com}
+#' @export
+
+###################################################################################################################
+### Inputs
+
+s = c( 1, 1);
+nu = 15;
+rhos = seq( -0.99, 0.99, 0.01 );
+nrhos = length(rhos);
+
+###################################################################################################################
+### Compute the correlation using simulation
+
+corrs2 = matrix( NaN, nrhos, 1);
+for( uu in 1 : nrhos )
+{
+    rho = rhos[ uu ];
+    Sigma = diag( s ) %*% rbind( c( 1, rho ), c( rho, 1 ) ) %*% diag( s );
+
+    # compute expected values of W_xx and W_xy, see (2.227) in "Risk and Asset Allocation - Springer
+    E_xx = nu * Sigma[ 1, 1 ];
+    E_xy = nu * Sigma[ 1, 2 ];
+
+    # compute covariance matrix of W_xx and W_xy, see (2.228) in "Risk and Asset Allocation - Springer
+    m = 1; n = 1; p = 1; q = 1;
+    var_Wxx = nu * ( Sigma[ m, p ] * Sigma[ n, q ] + Sigma[ m, q ] * Sigma[ n, p ] );
+    
+    m = 1; n = 2; p = 1; q = 2;
+    var_Wxy = nu * ( Sigma[ m, p ] * Sigma[ n, q ] + Sigma[ m, q ] * Sigma[ n, p ] );
+    
+    m = 1; n = 1; p = 1; q = 2;
+    cov_Wxx_Wxy = nu * ( Sigma[ m, p ] * Sigma[ n, q ] + Sigma[ m, q ] * Sigma[ n, p ] );
+
+    S_xx_xy = rbind( cbind( var_Wxx, cov_Wxx_Wxy ), cbind( cov_Wxx_Wxy, var_Wxy ));
+
+    # compute covariance of X_1 and X_2
+    S = diag( 1 / c( sqrt( var_Wxx ), sqrt( var_Wxy ))) %*% S_xx_xy %*% diag( 1 / c( sqrt( var_Wxx ), sqrt( var_Wxy )));
+
+    # correlation = covariance
+    corrs2[ uu ] = S[ 1, 2 ];
+}
+
+###################################################################################################################
+### Analytical correlation
+corrs = sqrt( 2 ) * rhos / sqrt( 1 + rhos ^ 2);
+
+figure();
+plot(rhos, corrs, xlab = expression( paste("input ", rho)), ylab = "Wishart correlation");
+lines( rhos, corrs2, col = "red" );



More information about the Returnanalytics-commits mailing list