[Returnanalytics-commits] r3118 - in pkg/Meucci: R demo man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 16 12:40:00 CEST 2013
Author: xavierv
Date: 2013-09-16 12:40:00 +0200 (Mon, 16 Sep 2013)
New Revision: 3118
Modified:
pkg/Meucci/R/LognormalCopulaPdf.R
pkg/Meucci/R/LognormalParameters2Statistics.R
pkg/Meucci/R/MvnRnd.R
pkg/Meucci/R/NormalCopulaPdf.R
pkg/Meucci/R/StudentTCopulaPdf.R
pkg/Meucci/R/TwoDimEllipsoid.R
pkg/Meucci/demo/S_AnalyzeLognormalCorrelation.R
pkg/Meucci/demo/S_AnalyzeNormalCorrelation.R
pkg/Meucci/demo/S_BivariateSample.R
pkg/Meucci/demo/S_BondProjectionPricingNormal.R
pkg/Meucci/demo/S_BondProjectionPricingStudentT.R
pkg/Meucci/demo/S_DerivativesInvariants.R
pkg/Meucci/demo/S_DisplayLognormalCopulaPdf.R
pkg/Meucci/demo/S_DisplayNormalCopulaCdf.R
pkg/Meucci/demo/S_DisplayNormalCopulaPdf.R
pkg/Meucci/demo/S_DisplayStudentTCopulaPdf.R
pkg/Meucci/demo/S_EllipticalNDim.R
pkg/Meucci/demo/S_ExactMeanAndCovariance.R
pkg/Meucci/demo/S_FullCodependence.R
pkg/Meucci/demo/S_FxCopulaMarginal.R
pkg/Meucci/demo/S_LognormalSample.R
pkg/Meucci/demo/S_MaxMinVariance.R
pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R
pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R
pkg/Meucci/demo/S_ResidualAnalysisTheory.R
pkg/Meucci/demo/S_SelectionHeuristics.R
pkg/Meucci/demo/S_Wishart.R
pkg/Meucci/demo/S_WishartCorrelation.R
pkg/Meucci/demo/S_WishartLocationDispersion.R
pkg/Meucci/man/LognormalCopulaPdf.Rd
pkg/Meucci/man/LognormalParam2Statistics.Rd
pkg/Meucci/man/MvnRnd.Rd
pkg/Meucci/man/NormalCopulaPdf.Rd
pkg/Meucci/man/StudentTCopulaPdf.Rd
pkg/Meucci/man/TwoDimEllipsoid.Rd
Log:
- updated documentation for chapter 2 demo scripts and its functions
Modified: pkg/Meucci/R/LognormalCopulaPdf.R
===================================================================
--- pkg/Meucci/R/LognormalCopulaPdf.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/R/LognormalCopulaPdf.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,14 +1,18 @@
-#' Computes the pdf of the copula of the lognormal distribution at the generic point u in the unit hypercube,
+#' @title Computes the pdf of the copula of the lognormal distribution at the generic point u in the unit hypercube.
+#'
+#' @description Computes the pdf of the copula of the lognormal 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) grades
-#' @param Mu : [vector] (N x 1) location parameter
-#' @param Sigma : [matrix] (N x N) scatter parameter
+#' @param u [vector] (J x 1) grades
+#' @param Mu [vector] (N x 1) location parameter
+#' @param Sigma [matrix] (N x N) scatter parameter
#'
-#' @return F_U : [vector] (J x 1) PDF values
+#' @return F_U [vector] (J x 1) PDF values
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 36 - Pdf of the lognormal copula".
+#'
#' See Meucci's script for "LognormalCopulaPdf.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
Modified: pkg/Meucci/R/LognormalParameters2Statistics.R
===================================================================
--- pkg/Meucci/R/LognormalParameters2Statistics.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/R/LognormalParameters2Statistics.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,6 +1,8 @@
-#' Compute expectation, Cov, standard deviation and Corr for a lognormal distribution, as described in
-#' A. Meucci "Risk and Asset Allocation", Springer, 2005
+#' @title Compute expectation, covariance, standard deviation and correlation for a lognormal distribution.
#'
+#' @description Compute expectation, covariance, standard deviation and correlation for a lognormal distribution, as described in
+#' A. Meucci "Risk and Asset Allocation", Springer, 2005.
+#'
#' @param Mu : [vector] (N x 1) location parameter
#' @param Sigma : [matrix] (N x N) scale parameter
#'
@@ -11,19 +13,21 @@
#' @return Corr : [matrix] (N x N) correlation
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 85 - Correlation in lognormal markets".
+#'
#' See Meucci's script for "LognormalParam2Statistics.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
#' @export
-LognormalParam2Statistics = function(Mu, Sigma)
+LognormalParam2Statistics = function( Mu, Sigma )
{
- Exp = exp( Mu + (1/2) * diag( Sigma ) );
- Cov = exp( Mu + (1/2) * diag( Sigma ) ) %*% t( exp( Mu + (1/2) * diag( Sigma ) ) ) * ( exp( Sigma ) - 1 );
- Std = sqrt( diag( Cov ) );
+ Exp = exp( Mu + (1/2) * diag( Sigma ) );
+ Cov = exp( Mu + (1/2) * diag( Sigma ) ) %*% t( exp( Mu + (1/2) * diag( Sigma ) ) ) * ( exp( Sigma ) - 1 );
+ Std = sqrt( diag( Cov ) );
Corr = diag( 1 / Std ) %*% Cov %*% diag( 1 / Std );
- return( list( Exp = Exp, Covariance = Cov, Standard_Deviation = Std, Correlation = Corr ));
+ return( list( Exp = Exp, Covariance = Cov, Standard_Deviation = Std, Correlation = Corr ) );
}
\ No newline at end of file
Modified: pkg/Meucci/R/MvnRnd.R
===================================================================
--- pkg/Meucci/R/MvnRnd.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/R/MvnRnd.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,4 +1,6 @@
-#' Generate normal simulations whose sample moments match the population moments,
+#' @title Generate normal simulations whose sample moments match the population moments
+#'
+#' @description Generate normal simulations whose sample moments match the population moments,
#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005.
#'
#' @param M : [vector] (N x 1) expectation
@@ -8,15 +10,18 @@
#' @return X : [matrix] (J x N) of drawsF_U : [vector] (J x 1) PDF values
#'
#' @references
-#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}., \url{http://www.symmys.com/node/162}{A. Meucci - "Simulations with Exact Means and Covariances", Risk, July 2009}
-#' See Meucci's script for "MvnRnd.m"
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 64 - Simulation of a multivariate normal random variable with matching moments".
#'
-#' @author Xavier Valls \email{flamejat@@gmail.com} and Ram Ahluwalia \email{rahluwalia@@gmail.com}
+#' See Meucci's script for "MvnRnd.m".
+#'
+#' @author Xavier Valls \email{flamejat@@gmail.com}
#' @export
MvnRnd = function( M, S, J )
{
- if ( !require( "QZ" ) ) stop("QZ package installation required for this script")
+ if ( !require( "QZ" ) ) stop("QZ package installation required for this script");
+
N = length(M);
# generate antithetic variables (mean = 0)
@@ -28,9 +33,6 @@
# solve Riccati equation using Schur method
H = rbind( cbind( matrix( 0, N, N ), -S ), cbind( -S, matrix( 0, N, N ) ) );
-
- #Schur = Schur( H );
- #U = ordschur(U_,T_,'lhp');
U = ordqz( H, keyword = "lhp" )$Q;
Modified: pkg/Meucci/R/NormalCopulaPdf.R
===================================================================
--- pkg/Meucci/R/NormalCopulaPdf.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/R/NormalCopulaPdf.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,18 +1,20 @@
-library(pracma);
-
-#' Computes the pdf of the copula of the normal distribution at the generic point u in the unit hypercube,
-#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005.
+#' @title Computes the pdf of the copula of the normal distribution at the generic point u in the unit hypercube
+#'
+#' @description Computes the pdf of the copula of the normal 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 Mu : [vector] (N x 1) mean
-#' @param Sigma : [matrix] (N x N) covariance
+#' @param u [vector] (J x 1) grade
+#' @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://}
-#' See Meucci's script for "LognormalCopulaPdf.m"
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 33 - Pdf of the normal copula".
#'
+#' See Meucci's script for "NormalCopulaPdf.m"
+#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
#' @export
Modified: pkg/Meucci/R/StudentTCopulaPdf.R
===================================================================
--- pkg/Meucci/R/StudentTCopulaPdf.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/R/StudentTCopulaPdf.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,6 +1,6 @@
-library(pracma);
-
-#' Pdf of the copula of the Student t distribution at the generic point u in the unit hypercube,
+#' @title Pdf of the copula of the Student t distribution at the generic point u in the unit hypercube
+#'
+#' @description 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
@@ -12,7 +12,9 @@
#' @return F_U : [vector] (J x 1) PDF values
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 88 - Copula vs. Correlation".
+#'
#' See Meucci's script for "StudentTCopulaPdf.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
Modified: pkg/Meucci/R/TwoDimEllipsoid.R
===================================================================
--- pkg/Meucci/R/TwoDimEllipsoid.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/R/TwoDimEllipsoid.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,7 +1,10 @@
-#' This script computes the location-dispersion ellipsoid of the normalized (unit variance, zero expectation)
-#' 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.
+#'@title Computes the location-dispersion ellipsoid of the normalized first diagonal and off-diagonal elements
+#' of a 2x2 Wishart distribution as a function of the inputs
#'
+#' @description This function computes the location-dispersion ellipsoid of the normalized (unit variance,
+#' zero expectation)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.
+#'
#' @param Location : [vector] (2 x 1) location vector (typically the expected value
#' @param Square_Dispersion : [matrix] (2 x 2) scatter matrix Square_Dispersion (typically the covariance matrix)
#' @param Scale : [scalar] a scalar Scale, that specifies the scale (radius) of the ellipsoid
@@ -11,7 +14,8 @@
#' @return E : [figure handle]
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}.
+#'
#' See Meucci's script for "TwoDimEllipsoid.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
Modified: pkg/Meucci/demo/S_AnalyzeLognormalCorrelation.R
===================================================================
--- pkg/Meucci/demo/S_AnalyzeLognormalCorrelation.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_AnalyzeLognormalCorrelation.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,12 +1,14 @@
#' This script considers a bivariate lognormal market and display the correlation and the condition number of the
#' covariance matrix, as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
-#' @references
-#' \url{http://}
+#' @references
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 85 - Correlation in lognormal markets".
+#'
#' See Meucci's script for "S_AnalyzeLognormalCorrelation.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
###########################################################################################################################################
Modified: pkg/Meucci/demo/S_AnalyzeNormalCorrelation.R
===================================================================
--- pkg/Meucci/demo/S_AnalyzeNormalCorrelation.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_AnalyzeNormalCorrelation.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,12 +1,14 @@
#' This script considers a bivariate normal market and display the correlation and the condition number of the
-#' covariance matrix, as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
+#' covariance matrix, as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 84 - Correlation in normal markets".
+#'
#' See Meucci's script for "S_AnalyzeNormalCorrelation.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
###################################################################################################################
### Set input parameters
@@ -14,10 +16,10 @@
Mu = rbind( 0, 0 )
s = c( 1, 1 );
-rhos = seq( -0.99, 0.99, 0.01 );
+rhos = seq( -0.99, 0.99, 0.01 );
nrhos = length( rhos );
-Cs = array( NaN, nrhos );
+Cs = array( NaN, nrhos );
CRs = array( NaN, nrhos );
@@ -26,7 +28,7 @@
for ( n in 1 : nrhos )
{
- rho = rhos[ n ] ;
+ rho = rhos[ n ] ;
Sigma = rbind( c(s[1]^2, rho * s[1] * s[2]), c(rho * s[1] * s[2], s[2]^2) );
Covariance = Sigma;
Modified: pkg/Meucci/demo/S_BivariateSample.R
===================================================================
--- pkg/Meucci/demo/S_BivariateSample.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_BivariateSample.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -2,7 +2,9 @@
#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 38 - Normal copula and given marginals".
+#'
#' See Meucci's script for "S_BivariateSample.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
Modified: pkg/Meucci/demo/S_BondProjectionPricingNormal.R
===================================================================
--- pkg/Meucci/demo/S_BondProjectionPricingNormal.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_BondProjectionPricingNormal.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -9,7 +9,7 @@
#' See Meucci's script for "S_BondProjectionPricingNormal.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
##################################################################################################################
### Inputs
Modified: pkg/Meucci/demo/S_BondProjectionPricingStudentT.R
===================================================================
--- pkg/Meucci/demo/S_BondProjectionPricingStudentT.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_BondProjectionPricingStudentT.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -8,7 +8,7 @@
#' See Meucci's script for "S_BondProjectionPricingStudentT.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
##################################################################################################################
### Inputs
Modified: pkg/Meucci/demo/S_DerivativesInvariants.R
===================================================================
--- pkg/Meucci/demo/S_DerivativesInvariants.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_DerivativesInvariants.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -6,7 +6,6 @@
#' See Meucci's script for "S_DerivativesInvariants.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
##################################################################################################################
### Load implied vol for options on SPX for different time to maturity and moneyness
Modified: pkg/Meucci/demo/S_DisplayLognormalCopulaPdf.R
===================================================================
--- pkg/Meucci/demo/S_DisplayLognormalCopulaPdf.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_DisplayLognormalCopulaPdf.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,13 +1,14 @@
-
-#'This script displays the pdf of the copula of a lognormal distribution, as described
+#' This script displays the pdf of the copula of a lognormal distribution, as described
#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 36 - Pdf of the lognormal copula".
+#'
#' See Meucci's script for "S_DisplayLognormalCopulaPdf.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
#############################################################################################################
### Input parameters
@@ -21,7 +22,7 @@
### Grid
GridSide1 = seq( 0.05, 0.95, 0.05 );
GridSide2 = GridSide1;
-nMesh = length(GridSide1);
+nMesh = length(GridSide1);
#############################################################################################################
### Compute pdf of copula
Modified: pkg/Meucci/demo/S_DisplayNormalCopulaCdf.R
===================================================================
--- pkg/Meucci/demo/S_DisplayNormalCopulaCdf.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_DisplayNormalCopulaCdf.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,12 +1,14 @@
-#'This script displays the cdf of the copula of a normal distribution, as described
+#' This script displays the cdf of the copula of a normal distribution, as described
#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 35 - Cdf of the normal copula".
+#'
#' See Meucci's script for "S_DisplayNormalCopulaCdf.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
#############################################################################################################
### Input parameters
Modified: pkg/Meucci/demo/S_DisplayNormalCopulaPdf.R
===================================================================
--- pkg/Meucci/demo/S_DisplayNormalCopulaPdf.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_DisplayNormalCopulaPdf.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,12 +1,12 @@
-#'This script displays the pdf of the copula of a normal distribution, as described
+#' This script displays the pdf of the copula of a normal 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"
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 33 - Pdf of the normal copula".
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
#############################################################################################################
### input parameters
Modified: pkg/Meucci/demo/S_DisplayStudentTCopulaPdf.R
===================================================================
--- pkg/Meucci/demo/S_DisplayStudentTCopulaPdf.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_DisplayStudentTCopulaPdf.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -2,11 +2,13 @@
#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 88 - Copula vs. Correlation".
+#'
#' See Meucci's script for "S_DisplayStudentTCopulaPdf.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
#############################################################################################################
### input parameters
Modified: pkg/Meucci/demo/S_EllipticalNDim.R
===================================================================
--- pkg/Meucci/demo/S_EllipticalNDim.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_EllipticalNDim.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -4,11 +4,13 @@
#' Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 81 - Radial-uniform representation".
+#'
#' See Meucci's script for "S_EllipticalNDim.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
##################################################################################################################
### Parameters
Modified: pkg/Meucci/demo/S_ExactMeanAndCovariance.R
===================================================================
--- pkg/Meucci/demo/S_ExactMeanAndCovariance.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_ExactMeanAndCovariance.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -2,12 +2,13 @@
#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}.
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 64 - Simulation of a multivariate normal random variable with matching moments".
+#'
#' See Meucci's script for "S_ExactMeanAndCovariance.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-
########################################################################################################
### Inputs
N = 20; # dimension (number of risk factors)
@@ -23,7 +24,6 @@
S = A %*% t( A );
# generate sample of size J from multivariate normal N(M,S)
-#X = mvnrnd(M, S, J); # no match between sample and population moments (built-in) function
X = MvnRnd( M, S, J ); # exact match between sample and population moments
########################################################################################################
Modified: pkg/Meucci/demo/S_FullCodependence.R
===================================================================
--- pkg/Meucci/demo/S_FullCodependence.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_FullCodependence.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -2,11 +2,12 @@
#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 89 - Full co-dependence".
+#'
#' See Meucci's script for "S_FullCodependence.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
#############################################################################################################
### Generate draws
Modified: pkg/Meucci/demo/S_FxCopulaMarginal.R
===================================================================
--- pkg/Meucci/demo/S_FxCopulaMarginal.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_FxCopulaMarginal.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -2,12 +2,14 @@
#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 39 - FX copula-marginal factorization".
+#'
#' See Meucci's script for "S_FxCopulaMarginal.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#############################################################################################################
### Load data and select the pair to display
data("fX" )
@@ -48,13 +50,9 @@
layout( matrix(c(1,2,2,1,2,2,0,3,3), 3, 3, byrow = TRUE), heights=c(1,2,1));
-
-
-#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-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_LognormalSample.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -8,7 +8,7 @@
#' See Meucci's script for "S_LognormalSample.m".
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
##################################################################################################################
### Input parameters
Modified: pkg/Meucci/demo/S_MaxMinVariance.R
===================================================================
--- pkg/Meucci/demo/S_MaxMinVariance.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_MaxMinVariance.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -2,13 +2,13 @@
#' in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}.
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 53 - Location-dispersion ellipsoid and statistics".
+#'
#' See Meucci's script for "S_MaxMinVariance.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-if ( !require( "mvtnorm" ) ) stop("mvtnorm package installation required for this script")
-
##################################################################################################################
### Input parameters
Mu = rbind( 0.5, 0.5 );
@@ -81,7 +81,7 @@
# plot statistics versus geometry
dev.new();
Scaled_Theta = Theta / (pi / 2);
- # plot standard deviation as function of direction
+# plot standard deviation as function of direction
plot( Scaled_Theta, SDev, type = "l", xlab = "theta/(pi/2)", xlim = c( Scaled_Theta[ 1 ], Scaled_Theta[length(Scaled_Theta)] ) );
# plot radius of ellipsoid as function of direction
lines( Scaled_Theta, Radius, col="red" );
Modified: pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R
===================================================================
--- pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_OrderStatisticsPdfLognormal.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,14 +1,14 @@
-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://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 78 - Order statistics".
+#'
#' See Meucci's script for "S_OrderStatisticsPdfLognormal.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
if ( !require( "scatterplot3d" ) ) stop("scatterplot3d package installation required for this script")
Modified: pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R
===================================================================
--- pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_OrderStatisticsPdfStudentT.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -2,11 +2,13 @@
#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 78 - Order statistics".
+#'
#' See Meucci's script for "S_OrderStatisticsPdfStudentT.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
if ( !require( "scatterplot3d" ) ) stop("scatterplot3d package installation required for this script")
Modified: pkg/Meucci/demo/S_ResidualAnalysisTheory.R
===================================================================
--- pkg/Meucci/demo/S_ResidualAnalysisTheory.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_ResidualAnalysisTheory.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -6,7 +6,7 @@
#' See Meucci's script for "S_ResidualAnalysisTheory.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
##################################################################################################################
### Inputs
Modified: pkg/Meucci/demo/S_SelectionHeuristics.R
===================================================================
--- pkg/Meucci/demo/S_SelectionHeuristics.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_SelectionHeuristics.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -215,7 +215,6 @@
#' See Meucci's script for "S_SelectionHeuristics.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#'
##################################################################################################################
Modified: pkg/Meucci/demo/S_Wishart.R
===================================================================
--- pkg/Meucci/demo/S_Wishart.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_Wishart.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,18 +1,21 @@
#' This script generates a sample from the 2x2 Wishart distribution.
-#' it shows that determinant and trace are positive, i.e. the matrix is positive
-#' it shows that the marginal diagonal are gamma-distributed
+#' - it shows that determinant and trace are positive, i.e. the matrix is positive
+#' - it shows that the marginal diagonal are gamma-distributed
#' Described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170}.
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 75 - Simulation of a Wishart random variable".
+#'
#' See Meucci's script for "S_Wishart.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
if ( !require( "scatterplot3d" ) ) stop("scatterplot3d package installation required for this script")
+
###################################################################################################################
### Set inputs
+
s = c( 1, 1 ); # variances
r = 0.3; # correlation
Sigma = diag( c( s ) ) %*% rbind( c( 1, r ), c( r, 1 ) ) %*% diag( c( s ) );
@@ -23,11 +26,11 @@
### Generate draws
# initialize storage vectors/matrices
-W_xx = matrix( NaN, nSim, 1 );
-W_yy = matrix( NaN, nSim, 1 );
-W_xy = matrix( NaN, nSim, 1 );
-Vec_W = matrix( NaN, nSim, 4 );
-Dets = matrix( NaN, nSim, 1 );
+W_xx = matrix( NaN, nSim, 1 );
+W_yy = matrix( NaN, nSim, 1 );
+W_xy = matrix( NaN, nSim, 1 );
+Vec_W = matrix( NaN, nSim, 4 );
+Dets = matrix( NaN, nSim, 1 );
Traces = matrix( NaN, nSim, 1 );
# generate draws and store elements of W, trace and determinant
@@ -112,4 +115,3 @@
print(Covariance);
print(Sample_Mean);
print(Sample_Covariance);
-
Modified: pkg/Meucci/demo/S_WishartCorrelation.R
===================================================================
--- pkg/Meucci/demo/S_WishartCorrelation.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_WishartCorrelation.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -3,11 +3,13 @@
#' "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 87 - Correlation and location-dispersion ellipsoid", "E 75 - Simulation of a Wishart random variable".
+#'
#' See Meucci's script for "S_WishartCorrelation.m"
#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
###################################################################################################################
### Inputs
Modified: pkg/Meucci/demo/S_WishartLocationDispersion.R
===================================================================
--- pkg/Meucci/demo/S_WishartLocationDispersion.R 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/demo/S_WishartLocationDispersion.R 2013-09-16 10:40:00 UTC (rev 3118)
@@ -3,11 +3,13 @@
#' as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005, Chapter 2.
#'
#' @references
-#' \url{http://}
-#' See Meucci's script for "S_WishartCorrelation.m"
+#' A. Meucci - "Exercises in Advanced Risk and Portfolio Management" \url{http://symmys.com/node/170},
+#' "E 87 - Correlation and location-dispersion ellipsoid", "E 75 - Simulation of a Wishart random variable".
#'
+#' See Meucci's script for "S_WishartLocationDispersion.m"
+#'
#' @author Xavier Valls \email{flamejat@@gmail.com}
-#' @export
+#'
###################################################################################################################
### Set input parameters
Modified: pkg/Meucci/man/LognormalCopulaPdf.Rd
===================================================================
--- pkg/Meucci/man/LognormalCopulaPdf.Rd 2013-09-16 09:42:42 UTC (rev 3117)
+++ pkg/Meucci/man/LognormalCopulaPdf.Rd 2013-09-16 10:40:00 UTC (rev 3118)
@@ -1,19 +1,18 @@
\name{LognormalCopulaPdf}
\alias{LognormalCopulaPdf}
-\title{Computes the pdf of the copula of the lognormal distribution at the generic point u in the unit hypercube,
-as described in A. Meucci, "Risk and Asset Allocation", Springer, 2005.}
+\title{Computes the pdf of the copula of the lognormal distribution at the generic point u in the unit hypercube.}
\usage{
LognormalCopulaPdf(u, Mu, Sigma)
}
\arguments{
- \item{u}{: [vector] (J x 1) grades}
+ \item{u}{[vector] (J x 1) grades}
- \item{Mu}{: [vector] (N x 1) location parameter}
+ \item{Mu}{[vector] (N x 1) location parameter}
- \item{Sigma}{: [matrix] (N x N) scatter parameter}
+ \item{Sigma}{[matrix] (N x N) scatter parameter}
}
\value{
- F_U : [vector] (J x 1) PDF values
+ F_U [vector] (J x 1) PDF values
}
\description{
Computes the pdf of the copula of the lognormal
@@ -25,7 +24,10 @@
Xavier Valls \email{flamejat at gmail.com}
}
\references{
- \url{http://} See Meucci's script for
- "LognormalCopulaPdf.m"
+ A. Meucci - "Exercises in Advanced Risk and Portfolio
+ Management" \url{http://symmys.com/node/170}, "E 36 - Pdf
+ of the lognormal copula".
+
+ See Meucci's script for "LognormalCopulaPdf.m"
}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3118
More information about the Returnanalytics-commits
mailing list