[Returnanalytics-commits] r3405 - in pkg/PortfolioAnalytics: R sandbox src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 3 21:52:09 CEST 2014
Author: rossbennett34
Date: 2014-06-03 21:52:08 +0200 (Tue, 03 Jun 2014)
New Revision: 3405
Added:
pkg/PortfolioAnalytics/sandbox/scriptMF.R
pkg/PortfolioAnalytics/sandbox/scriptSF.R
Modified:
pkg/PortfolioAnalytics/R/stat.factor.model.R
pkg/PortfolioAnalytics/src/residualcokurtosisMF.c
pkg/PortfolioAnalytics/src/residualcokurtosisSF.c
Log:
Fixing calls to residual cokurtosis functions and adding script for multi factor and single factor model examples
Modified: pkg/PortfolioAnalytics/R/stat.factor.model.R
===================================================================
--- pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-03 19:04:47 UTC (rev 3404)
+++ pkg/PortfolioAnalytics/R/stat.factor.model.R 2014-06-03 19:52:08 UTC (rev 3405)
@@ -212,7 +212,7 @@
cokurtosisSF <- function(beta, stockM2, stockM4, factorM2, factorM4){
# Beta of the stock with the factor index
beta = as.numeric(beta)
- N = length(beta)
+ N = as.integer(length(beta))
# Idiosyncratic second moment of the stock
stockM2 = as.numeric(stockM2)
@@ -250,7 +250,7 @@
# bbeta : vector of length NN
# Should I add checks here? These are passed from cokurtosisSF which already has checks
- .Call('residualcokurtosisSF', NN, sstockM2, sstockM4, bbeta, PACKAGE="PortfolioAnalytics")
+ .Call('residualcokurtosisSF', NN, sstockM2, sstockM4, mfactorM2, bbeta, PACKAGE="PortfolioAnalytics")
}
##### Multiple Factor Model Comoments #####
Added: pkg/PortfolioAnalytics/sandbox/scriptMF.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/scriptMF.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/scriptMF.R 2014-06-03 19:52:08 UTC (rev 3405)
@@ -0,0 +1,69 @@
+library(PortfolioAnalytics)
+
+# Use edhec data
+data(edhec)
+
+R <- edhec[,1:10]
+
+# Dimensions of data
+m <- nrow(R)
+N <- ncol(R)
+
+# Number of factors to use
+k <- 3
+
+##### Step 1 #####
+fit <- statistical.factor.model(R, k)
+names(fit)
+beta <- fit$factor_loadings
+f <- fit$factor_realizations
+res <- fit$residuals
+
+##### Step 2 #####
+# Compute the moments of the factors and idiosyncratic risk factors
+# Note: The idiosyncratic factors are the residuals in the model (i.e. the
+# unexplained asset return variation)
+
+# Check for equality with functions from Kris Boudt and functions I have
+# included in the package
+
+# residual moments
+denom <- m - k - 1
+stockM2 <- colSums(res^2) / denom
+stockM3 <- colSums(res^3) / denom
+stockM4 <- colSums(res^4) / denom
+
+# Compute the centered factors
+# f.centered <- center(f)
+
+# factor moments
+# (k x k)
+factorM2 <- cov(f)
+
+# (k x k^2)
+factorM3 <- PerformanceAnalytics:::M3.MM(f)
+
+# (k x k^3)
+factorM4 <- PerformanceAnalytics:::M4.MM(f)
+
+##### Step 3 #####
+# Compute the covariance, coskewness, and cokurtosis estimates from the statistical
+# factor model.
+
+# covariance matrix
+all.equal(
+ PortfolioAnalytics:::covarianceMF(beta, stockM2, factorM2),
+ extractCovariance(fit)
+)
+
+# coskewness matrix
+all.equal(
+ PortfolioAnalytics:::coskewnessMF(beta, stockM3, factorM3),
+ extractCoskewness(fit)
+)
+
+# cokurtosis matrix
+all.equal(
+ PortfolioAnalytics:::cokurtosisMF(beta, stockM2,stockM4, factorM2, factorM4),
+ extractCokurtosis(fit)
+)
Added: pkg/PortfolioAnalytics/sandbox/scriptSF.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/scriptSF.R (rev 0)
+++ pkg/PortfolioAnalytics/sandbox/scriptSF.R 2014-06-03 19:52:08 UTC (rev 3405)
@@ -0,0 +1,69 @@
+library(PortfolioAnalytics)
+
+# Use edhec data
+data(edhec)
+
+R <- edhec[,1:10]
+
+# Dimensions of data
+m <- nrow(R)
+N <- ncol(R)
+
+# Number of factors to use
+k <- 1
+
+##### Step 1 #####
+fit <- statistical.factor.model(R, k)
+names(fit)
+beta <- fit$factor_loadings
+f <- fit$factor_realizations
+res <- fit$residuals
+
+##### Step 2 #####
+# Compute the moments of the factors and idiosyncratic risk factors
+# Note: The idiosyncratic factors are the residuals in the model (i.e. the
+# unexplained asset return variation)
+
+# Check for equality with functions from Kris Boudt and functions I have
+# included in the package
+
+# residual moments
+denom <- m - k - 1
+stockM2 <- colSums(res^2) / denom
+stockM3 <- colSums(res^3) / denom
+stockM4 <- colSums(res^4) / denom
+
+# Compute the centered factors
+# f.centered <- center(f)
+
+# factor moments
+# scalar
+factorM2 <- cov(f)
+
+# scalar
+factorM3 <- PerformanceAnalytics:::M3.MM(f)
+
+# scalar
+factorM4 <- PerformanceAnalytics:::M4.MM(f)
+
+##### Step 3 #####
+# Compute the covariance, coskewness, and cokurtosis estimates from the statistical
+# factor model.
+
+# covariance matrix
+all.equal(
+ PortfolioAnalytics:::covarianceSF(beta, stockM2, factorM2),
+ extractCovariance(fit)
+)
+
+# coskewness matrix
+all.equal(
+ PortfolioAnalytics:::coskewnessSF(beta, stockM3, factorM3),
+ extractCoskewness(fit)
+)
+
+# # cokurtosis matrix
+all.equal(
+ PortfolioAnalytics:::cokurtosisSF(beta, stockM2, stockM4, factorM2, factorM4),
+ extractCokurtosis(fit)
+)
Modified: pkg/PortfolioAnalytics/src/residualcokurtosisMF.c
===================================================================
--- pkg/PortfolioAnalytics/src/residualcokurtosisMF.c 2014-06-03 19:04:47 UTC (rev 3404)
+++ pkg/PortfolioAnalytics/src/residualcokurtosisMF.c 2014-06-03 19:52:08 UTC (rev 3405)
@@ -2,7 +2,7 @@
#include <R.h>
#include <Rinternals.h>
-SEXP residualcokurtosisMF_C(SEXP NN, SEXP sstockM2, SEXP sstockM4, SEXP bbetacov){
+SEXP residualcokurtosisMF(SEXP NN, SEXP sstockM2, SEXP sstockM4, SEXP bbetacov){
/*
arguments
NN : integer, number of assets
Modified: pkg/PortfolioAnalytics/src/residualcokurtosisSF.c
===================================================================
--- pkg/PortfolioAnalytics/src/residualcokurtosisSF.c 2014-06-03 19:04:47 UTC (rev 3404)
+++ pkg/PortfolioAnalytics/src/residualcokurtosisSF.c 2014-06-03 19:52:08 UTC (rev 3405)
@@ -63,7 +63,8 @@
if( (i==j) || (i==k) || (i==l) || (j==k) || (j==l) || (k==l) ) {
if( (i==j) && (i==k) && (i==l) ) {
// These are the kurtosis estimates of the individual assets: E[u^4]
- kijkl = 6*pow(beta[i],2)*factorM2*stockM2[i]+stockM4[i];
+ // kijkl = 6*R_pow_di(beta[i],2)*factorM2*stockM2[i]+stockM4[i];
+ kijkl = 6*beta[i]*beta[i]*factorM2*stockM2[i]+stockM4[i];
} else {
if( ((i==j) && (i==k)) || ((i==j) && (i==l)) || ((i==k) && (i==l)) || ((j==k) && (j==l)) ) {
// kiij E[ U[,i]^3*U[,j] ] = r3*sqrt( vm6[i]*vm2[j] )
@@ -83,13 +84,16 @@
if( ((i==j) && (k==l)) || ((i==k) && (j==l)) || ((i==l) && (j==k)) ) {
// kiijj = E[ U[,i]^2*U[,j]^2 ] = r5*sqrt( vm4[i]*vm4[j] )
if( (i==j) && (k==l) ) {
- kijkl = pow(beta[i],2)*factorM2*stockM2[k] + pow(beta[k],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[k];
+ //kijkl = R_pow_di(beta[i],2)*factorM2*stockM2[k] + R_pow_di(beta[k],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[k];
+ kijkl = beta[i]*beta[i]*factorM2*stockM2[k] + beta[k]*beta[k]*factorM2*stockM2[i]+stockM2[i]*stockM2[k];
} else
if( (i==k) && (j==l) ) {
- kijkl = pow(beta[i],2)*factorM2*stockM2[j] + pow(beta[j],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[j];
+ //kijkl = R_pow_di(beta[i],2)*factorM2*stockM2[j] + R_pow_di(beta[j],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[j];
+ kijkl = beta[i]*beta[i]*factorM2*stockM2[j] + beta[j]*beta[j]*factorM2*stockM2[i]+stockM2[i]*stockM2[j];
} else
if( (i==l) && (j==k) ) {
- kijkl = pow(beta[i],2)*factorM2*stockM2[j] + pow(beta[j],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[j];
+ //kijkl = R_pow_di(beta[i],2)*factorM2*stockM2[j] + R_pow_di(beta[j],2)*factorM2*stockM2[i]+stockM2[i]*stockM2[j];
+ kijkl = beta[i]*beta[i]*factorM2*stockM2[j] + beta[j]*beta[j]*factorM2*stockM2[i]+stockM2[i]*stockM2[j];
}
} else {
// kiijk = E[ U[,i]^2*U[,j]*U[,k] ] = r6*sqrt( vm4[i]*r5*sqrt( vm4[j]*vm4[k] ) )
More information about the Returnanalytics-commits
mailing list