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

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

Author: xavierv
Date: 2013-06-19 19:20:55 +0200 (Wed, 19 Jun 2013)
New Revision: 2378

Added:
   pkg/Meucci/R/StudentTCopulaPdf.R
   pkg/Meucci/demo/S_DisplayStudentTCopulaPdf.R
Modified:
   pkg/Meucci/DESCRIPTION
   pkg/Meucci/NAMESPACE
   pkg/Meucci/R/LognormalCopulaPdf.R
   pkg/Meucci/R/NormalCopulaPdf.R
Log:
- added demos for displaying Student T distribution Copula pdf

Modified: pkg/Meucci/DESCRIPTION
===================================================================
--- pkg/Meucci/DESCRIPTION	2013-06-19 16:23:02 UTC (rev 2377)
+++ pkg/Meucci/DESCRIPTION	2013-06-19 17:20:55 UTC (rev 2378)
@@ -64,3 +64,4 @@
     'LognormalParameters2Statistics.R'
     'LognormalCopulaPdf.R'
     'NormalCopulaPdf.R'
+    'StudentTCopulaPdf.R'

Modified: pkg/Meucci/NAMESPACE
===================================================================
--- pkg/Meucci/NAMESPACE	2013-06-19 16:23:02 UTC (rev 2377)
+++ pkg/Meucci/NAMESPACE	2013-06-19 17:20:55 UTC (rev 2378)
@@ -11,12 +11,10 @@
 export(hermitePolynomial)
 export(integrateSubIntervals)
 export(linreturn)
-export(LognormalCopulaPdf)
 export(LognormalMoments2Parameters)
 export(LognormalParam2Statistics)
 export(MvnRnd)
 export(NoisyObservations)
-export(NormalCopulaPdf)
 export(normalizeProb)
 export(PanicCopula)
 export(PartialConfidencePosterior)

Modified: pkg/Meucci/R/LognormalCopulaPdf.R
===================================================================
--- pkg/Meucci/R/LognormalCopulaPdf.R	2013-06-19 16:23:02 UTC (rev 2377)
+++ pkg/Meucci/R/LognormalCopulaPdf.R	2013-06-19 17:20:55 UTC (rev 2378)
@@ -15,6 +15,8 @@
 #' @author Xavier Valls \email{flamejat@@gmail.com}
 #' @export
 
+library(pracma);
+
 LognormalCopulaPdf = function( u, Mu, Sigma )
 {
 	N = length( u );

Modified: pkg/Meucci/R/NormalCopulaPdf.R
===================================================================
--- pkg/Meucci/R/NormalCopulaPdf.R	2013-06-19 16:23:02 UTC (rev 2377)
+++ pkg/Meucci/R/NormalCopulaPdf.R	2013-06-19 17:20:55 UTC (rev 2378)
@@ -5,7 +5,7 @@
 #'	@param   Mu    : [vector] (N x 1) mean
 #'	@param   Sigma : [matrix] (N x N) covariance
 #'  
-#'	@return   F_U   : [vector] (J x 1) PDF values
+#'	@return  F_U   : [vector] (J x 1) PDF values
 #'
 #' @references
 #' \url{http://}
@@ -14,6 +14,8 @@
 #' @author Xavier Valls \email{flamejat@@gmail.com}
 #' @export
 
+library(pracma);
+
 NormalCopulaPdf = function( u, Mu, Sigma )
 {
 	N = length( u );
@@ -21,7 +23,7 @@
 
 	x = qnorm( u, Mu, s );
 
-	Numerator = ( 2 * pi ) ^ ( -N / 2 ) * ( (det ( Sigma ) ) ^ ( -0.5 ) ) * exp( -0.5 * t(x - Mu) %*% mldivide( Sigma , ( x  - Mu ), pinv = FALSE ) );
+	Numerator = ( 2 * pi ) ^ ( -N / 2 ) * ( (det ( Sigma ) ) ^ ( -0.5 ) ) * exp( -0.5 * t(x - Mu) %*% mldivide( Sigma , ( x  - Mu )));
 
 	fs = dnorm( x, Mu, s);
 

Added: pkg/Meucci/R/StudentTCopulaPdf.R
===================================================================
--- pkg/Meucci/R/StudentTCopulaPdf.R	                        (rev 0)
+++ pkg/Meucci/R/StudentTCopulaPdf.R	2013-06-19 17:20:55 UTC (rev 2378)
@@ -0,0 +1,41 @@
+#' Pdf of the copula of the Student t distribution at the generic point u in the unit hypercube,
+#' as described in  A. Meucci, "Risk and Asset Allocation", Springer, 2005.
+#'  
+#'	@param   u     : [vector] (J x 1) grade
+#'	@param	 nu    : [numerical] 	  degrees of freedom 
+#'	@param   Mu    : [vector] (N x 1) mean
+#'	@param   Sigma : [matrix] (N x N) scatter
+#'	
+#'  
+#'	@return   F_U   : [vector] (J x 1) PDF values
+#'
+#' @references
+#' \url{http://}
+#' See Meucci's script for "StudentTCopulaPdf.m"
+#'
+#' @author Xavier Valls \email{flamejat@@gmail.com}
+#' @export
+
+library(pracma);
+
+
+StudentTCopulaPdf = function( u, nu, Mu, Sigma )
+{
+	N = length( u );
+	s = sqrt( diag( Sigma ));
+
+	x = Mu + s * qt( u, nu);
+
+	z2 = t(x - Mu) %*% mldivide( Sigma, (x - Mu)); #z2 = t(x - Mu) %*% inv(Sigma) * (x-Mu);
+	K  = ( nu * pi )^( -N / 2 ) * gamma( ( nu + N ) / 2 ) / gamma( nu / 2 ) * ( ( det( Sigma ) )^( -0.5 ));
+	Numerator = K * (1 + z2 / nu)^(-(nu + N) / 2);
+	
+
+	fs = dt((x - Mu) / s , nu);
+
+	Denominator = prod(fs);
+
+	F_U = Numerator / Denominator;
+
+	return ( F_U );
+}

Added: pkg/Meucci/demo/S_DisplayStudentTCopulaPdf.R
===================================================================
--- pkg/Meucci/demo/S_DisplayStudentTCopulaPdf.R	                        (rev 0)
+++ pkg/Meucci/demo/S_DisplayStudentTCopulaPdf.R	2013-06-19 17:20:55 UTC (rev 2378)
@@ -0,0 +1,45 @@
+#'This script displays the pdf of the copula of a Student t distribution, as described 
+#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005,  Chapter 2.
+#'
+#' @references
+#' \url{http://}
+#' See Meucci's script for "S_DisplayNormalCopulaPdf.m"
+#'
+#' @author Xavier Valls \email{flamejat@@gmail.com}
+#' @export
+
+#############################################################################################################
+### input parameters
+
+Mu = rbind( 0, 0 );     
+r  = 0.5;            
+sigmas = rbind( 1, 2 );    
+Sigma = diag( c( sigmas ) ) %*% rbind( c( 1, r ), c( r, 1 ) ) %*% diag( c( sigmas ) );
+#nu = 1; Sigma(1,2) = 0; Sigma(2,1) = 0;
+nu = 200; 
+
+#############################################################################################################
+### Grid
+GridSide1 = seq( 0.05, 0.95, 0.05 );
+GridSide2 = GridSide1;
+nMesh = length(GridSide1);
+
+#############################################################################################################
+### Compute pdf of copula
+
+f_U = matrix( NaN, nMesh, nMesh);
+
+for ( j in 1 : nMesh )
+{
+    for ( k in 1 : nMesh)
+    {
+        u = c( GridSide1[ j ], GridSide2[ k ] );        
+        f_U[ j, k ] = StudentTCopulaPdf( u, nu, Mu, Sigma );         
+    }
+}
+
+#mesh representation    
+
+persp( GridSide1, GridSide2, f_U,
+	theta = 7 * 45, phi = 30, expand=0.6, col='lightblue', shade=0.75, ltheta=120, 
+	ticktype='detailed', xlab = "U_1", ylab = "U_2", zlab = "copula pdf" );