[Returnanalytics-commits] r2704 - in pkg/FactorAnalytics: . R data man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 2 23:32:20 CEST 2013
Author: chenyian
Date: 2013-08-02 23:32:20 +0200 (Fri, 02 Aug 2013)
New Revision: 2704
Removed:
pkg/FactorAnalytics/data/CRSP.RDATA
pkg/FactorAnalytics/data/CommomFactors.RData
Modified:
pkg/FactorAnalytics/NAMESPACE
pkg/FactorAnalytics/R/factorModelCovariance.r
pkg/FactorAnalytics/R/factorModelEsDecomposition.R
pkg/FactorAnalytics/R/factorModelSdDecomposition.R
pkg/FactorAnalytics/R/factorModelVaRDecomposition.R
pkg/FactorAnalytics/R/fitFundamentalFactorModel.R
pkg/FactorAnalytics/R/fitStatisticalFactorModel.R
pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r
pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r
pkg/FactorAnalytics/data/
pkg/FactorAnalytics/man/factorModelCovariance.Rd
pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd
pkg/FactorAnalytics/man/fitStatisticalFactorModel.Rd
pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd
Log:
1. debug function arguments in Rd file do not match function itself.
2. delete CRSP.RDATA which is a duplicate of stock.RData
Modified: pkg/FactorAnalytics/NAMESPACE
===================================================================
--- pkg/FactorAnalytics/NAMESPACE 2013-08-02 19:26:57 UTC (rev 2703)
+++ pkg/FactorAnalytics/NAMESPACE 2013-08-02 21:32:20 UTC (rev 2704)
@@ -1,5 +1,11 @@
export(dCornishFisher)
+export(factorModelCovariance)
+export(factorModelEsDecomposition)
export(factorModelMonteCarlo)
+export(factorModelSdDecomposition)
+export(factorModelVaRDecomposition)
+export(fitFundamentalFactorModel)
+export(fitStatisticalFactorModel)
export(fitTimeSeriesFactorModel)
export(pCornishFisher)
export(qCornishFisher)
Modified: pkg/FactorAnalytics/R/factorModelCovariance.r
===================================================================
--- pkg/FactorAnalytics/R/factorModelCovariance.r 2013-08-02 19:26:57 UTC (rev 2703)
+++ pkg/FactorAnalytics/R/factorModelCovariance.r 2013-08-02 21:32:20 UTC (rev 2704)
@@ -21,71 +21,63 @@
#' @author Eric Zivot and Yi-An Chen.
#' @references Zivot, E. and J. Wang (2006), \emph{Modeling Financial Time
#' Series with S-PLUS, Second Edition}, Springer-Verlag.
+#' @export
#' @examples
-#'
+#' \dontrun{
#' # Time Series model
#'
#' data(managers.df)
#' factors = managers.df[,(7:9)]
-#' fit <- fitTimeseriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
+#' fit <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
#' factors.names=c("EDHEC.LS.EQ","SP500.TR"),
#' data=managers.df,fit.method="OLS")
+#' factors = managers.df[,(7:8)]
#' factorModelCovariance(fit$beta,var(factors),fit$resid.variance)
#'
#' # Statistical Model
#' data(stat.fm.data)
-#' fit <- fitStatisticalFactorModel(sfm.dat,k=2,
-#' ckeckData.method="data.frame")
+#' sfm.pca.fit <- fitStatisticalFactorModel(sfm.dat,k=2)
+#' #' factorModelCovariance(t(sfm.pca.fit$loadings),var(sfm.pca.fit$factors),sfm.pca.fit$resid.variance)
#'
-#' factorModelCovariance(t(sfm.pca.fit$loadings),var(sfm.pca.fit$factors),sfm.pca.fit$resid.variance)
+#' sfm.apca.fit <- fitStatisticalFactorModel(sfm.apca.dat,k=2)
#'
-#' sfm.apca.fit <- fitStatisticalFactorModel(sfm.apca.dat,k=2
-#' ,ckeckData.method="data.frame")
-#'
#' factorModelCovariance(t(sfm.apca.fit$loadings),
#' var(sfm.apca.fit$factors),sfm.apca.fit$resid.variance)
#'
#' # fundamental factor model example
-#'
-#'
+#' #'
#' data(stock)
#' # there are 447 assets
#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP")
-#' test.fit <- fitFundamentalFactorModel(data=data,exposure.names=exposure.names,
-#' datevar = "DATE", returnsvar = "RETURN",
-#' assetvar = "TICKER", wls = TRUE,
-#' regression = "classic",
-#' covariance = "classic", full.resid.cov = FALSE,
-#' robust.scale = TRUE)
-#'
-#' # compute return covariance
-#' # take beta as latest date input
-#' beta.mat.fundm <- subset(data,DATE == "2003-12-31")[,exposure.names]
-#' beta.mat.fundm <- cbind(rep(1,447),beta.mat.fundm) # add intercept
-#' FM return covariance
-#' ret.cov.fundm <- factorModelCovariance(beta.mat.fundm,test.fit$factor.cov$cov,
-#' test.fit$resid.variance)
-#' # the result is exactly the same
-#' test.fit$returns.cov$cov == ret.cov.fundm
-#'
+#' beta.mat <- subset(stock,DATE == "2003-12-31")[,exposure.names]
+#' beta.mat1 <- cbind(rep(1,447),beta.mat1)
+# FM return covariance
+#' fit.fund <- fitFundamentalFactorModel(exposure.names=c("BOOK2MARKET", "LOG.MARKETCAP")
+#' , data=stock,returnsvar = "RETURN",datevar = "DATE",
+#' assetvar = "TICKER",
+#' wls = TRUE, regression = "classic",
+#' covariance = "classic", full.resid.cov = FALSE)
+#' ret.cov.fundm <- factorModelCovariance(beta.mat1,fit.fund$factor.cov$cov,fit.fund$resid.variance)
+#' fit.fund$returns.cov$cov == ret.cov.fundm
+#' }
factorModelCovariance <-
-function(beta.mat, factor.cov, residVars.vec) {
+function(beta, factor.cov, resid.variance) {
- beta.mat = as.matrix(beta.mat)
+ beta = as.matrix(beta)
factor.cov = as.matrix(factor.cov)
- sig.e = as.vector(residVars.vec)
+ sig.e = as.vector(resid.variance)
if (length(sig.e) > 1) {
D.e = diag(as.vector(sig.e))
} else {
D.e = as.matrix(sig.e)
}
- if (ncol(beta.mat) != ncol(factor.cov))
- stop("beta.mat and factor.cov must have same number of columns")
+ if (ncol(beta) != ncol(factor.cov))
+ stop("beta and factor.cov must have same number of columns")
- if (nrow(D.e) != nrow(beta.mat))
- stop("beta.mat and D.e must have same number of rows")
- cov.fm = beta.mat %*% factor.cov %*% t(beta.mat) + D.e
+ if (nrow(D.e) != nrow(beta))
+ stop("beta and D.e must have same number of rows")
+ cov.fm = beta %*% factor.cov %*% t(beta) + D.e
if (any(diag(chol(cov.fm)) == 0))
warning("Covariance matrix is not positive definite")
return(cov.fm)
Modified: pkg/FactorAnalytics/R/factorModelEsDecomposition.R
===================================================================
--- pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2013-08-02 19:26:57 UTC (rev 2703)
+++ pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2013-08-02 21:32:20 UTC (rev 2704)
@@ -68,8 +68,8 @@
#' fit.fund$beta["STI",],
#' fit.fund$resid.variance["STI"], tail.prob=0.05)
#'
+#' @export
#'
-#'
factorModelEsDecomposition <-
function(Data, beta.vec, sig2.e, tail.prob = 0.05) {
## Compute factor model factor ES decomposition based on Euler's theorem given historic
Modified: pkg/FactorAnalytics/R/factorModelSdDecomposition.R
===================================================================
--- pkg/FactorAnalytics/R/factorModelSdDecomposition.R 2013-08-02 19:26:57 UTC (rev 2703)
+++ pkg/FactorAnalytics/R/factorModelSdDecomposition.R 2013-08-02 21:32:20 UTC (rev 2704)
@@ -1,89 +1,89 @@
-#' Compute factor model factor risk (sd) decomposition for individual fund.
-#'
-#' Compute factor model factor risk (sd) decomposition for individual fund.
-#'
-#'
-#' @param beta.vec k x 1 vector of factor betas with factor names in the
-#' rownames.
-#' @param factor.cov k x k factor excess return covariance matrix.
-#' @param sig2.e scalar, residual variance from factor model.
-#' @return an S3 object containing
-#' @returnItem sd.fm Scalar, std dev based on factor model.
-#' @returnItem mcr.fm (K+1) x 1 vector of factor marginal contributions to risk
-#' (sd).
-#' @returnItem cr.fm (K+1) x 1 vector of factor component contributions to risk
-#' (sd).
-#' @returnItem pcr.fm (K+1) x 1 vector of factor percent contributions to risk
-#' (sd).
-#' @author Eric Zivot and Yi-An Chen
-#' @examples
-#'
-#' # load data from the database
-#' data(managers.df)
-#' ret.assets = managers.df[,(1:6)]
-#' factors = managers.df[,(7:9)]
-#' # fit the factor model with OLS
-#' fit <- fitMacroeconomicFactorModel(ret.assets,factors,fit.method="OLS",
-#' variable.selection="all subsets",
-#' factor.set = 3)
-#' # factor SD decomposition for HAM1
-#' cov.factors = var(factors)
-#' manager.names = colnames(managers.df[,(1:6)])
-#' factor.names = colnames(managers.df[,(7:9)])
-#' factor.sd.decomp.HAM1 = factorModelSdDecomposition(fit$beta.mat["HAM1",],
-#' cov.factors, fit$residVars.vec["HAM1"])
-#'
-#'
-#'
-factorModelSdDecomposition <-
-function(beta.vec, factor.cov, sig2.e) {
-## Inputs:
-## beta k x 1 vector of factor betas with factor names in the rownames
-## factor.cov k x k factor excess return covariance matrix
-## sig2.e scalar, residual variance from factor model (residVars.vec in fitFundamentalFactorModel)
-## Output:
-## A list with the following components:
-## sd.fm scalar, std dev based on factor model
-## mcr.fm k+1 x 1 vector of factor marginal contributions to risk (sd)
-## cr.fm k+1 x 1 vector of factor component contributions to risk (sd)
-## pcr.fm k+1 x 1 vector of factor percent contributions to risk (sd)
-## Remarks:
-## The factor model has the form
-## R(t) = beta'F(t) + e(t) = beta.star'F.star(t)
-## where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))'
-## By Euler's theorem
-## sd.fm = sum(cr.fm) = sum(beta*mcr.fm)
- if(is.matrix(beta.vec)) {
- beta.names = c(rownames(beta.vec), "residual")
- } else if(is.vector(beta.vec)) {
- beta.names = c(names(beta.vec), "residual")
- } else {
- stop("beta.vec is not a matrix or a vector")
- }
- beta.vec = as.vector(beta.vec)
- beta.star.vec = c(beta.vec, sqrt(sig2.e))
- names(beta.star.vec) = beta.names
- factor.cov = as.matrix(factor.cov)
- k.star = length(beta.star.vec)
- k = k.star - 1
- factor.star.cov = diag(k.star)
- factor.star.cov[1:k, 1:k] = factor.cov
-
-## compute factor model sd
- sd.fm = as.numeric(sqrt(t(beta.star.vec) %*% factor.star.cov %*% beta.star.vec))
-## compute marginal and component contributions to sd
- mcr.fm = (factor.star.cov %*% beta.star.vec)/sd.fm
- cr.fm = mcr.fm * beta.star.vec
- pcr.fm = cr.fm/sd.fm
- rownames(mcr.fm) <- rownames(cr.fm) <- rownames(pcr.fm) <- beta.names
- colnames(mcr.fm) = "MCR"
- colnames(cr.fm) = "CR"
- colnames(pcr.fm) = "PCR"
-## return results
- ans = list(sd.fm = sd.fm,
- mcr.fm = t(mcr.fm),
- cr.fm = t(cr.fm),
- pcr.fm = t(pcr.fm))
- return(ans)
-}
-
+#' Compute factor model factor risk (sd) decomposition for individual fund.
+#'
+#' Compute factor model factor risk (sd) decomposition for individual fund.
+#'
+#'
+#' @param beta.vec k x 1 vector of factor betas with factor names in the
+#' rownames.
+#' @param factor.cov k x k factor excess return covariance matrix.
+#' @param sig2.e scalar, residual variance from factor model.
+#' @return an S3 object containing
+#' @returnItem sd.fm Scalar, std dev based on factor model.
+#' @returnItem mcr.fm (K+1) x 1 vector of factor marginal contributions to risk
+#' (sd).
+#' @returnItem cr.fm (K+1) x 1 vector of factor component contributions to risk
+#' (sd).
+#' @returnItem pcr.fm (K+1) x 1 vector of factor percent contributions to risk
+#' (sd).
+#' @author Eric Zivot and Yi-An Chen
+#' @examples
+#'
+#' # load data from the database
+#' data(managers.df)
+#' ret.assets = managers.df[,(1:6)]
+#' factors = managers.df[,(7:9)]
+#' # fit the factor model with OLS
+#' fit <- fitMacroeconomicFactorModel(ret.assets,factors,fit.method="OLS",
+#' variable.selection="all subsets",
+#' factor.set = 3)
+#' # factor SD decomposition for HAM1
+#' cov.factors = var(factors)
+#' manager.names = colnames(managers.df[,(1:6)])
+#' factor.names = colnames(managers.df[,(7:9)])
+#' factor.sd.decomp.HAM1 = factorModelSdDecomposition(fit$beta.mat["HAM1",],
+#' cov.factors, fit$residVars.vec["HAM1"])
+#'
+#' @export
+#'
+factorModelSdDecomposition <-
+function(beta.vec, factor.cov, sig2.e) {
+## Inputs:
+## beta k x 1 vector of factor betas with factor names in the rownames
+## factor.cov k x k factor excess return covariance matrix
+## sig2.e scalar, residual variance from factor model (residVars.vec in fitFundamentalFactorModel)
+## Output:
+## A list with the following components:
+## sd.fm scalar, std dev based on factor model
+## mcr.fm k+1 x 1 vector of factor marginal contributions to risk (sd)
+## cr.fm k+1 x 1 vector of factor component contributions to risk (sd)
+## pcr.fm k+1 x 1 vector of factor percent contributions to risk (sd)
+## Remarks:
+## The factor model has the form
+## R(t) = beta'F(t) + e(t) = beta.star'F.star(t)
+## where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))'
+## By Euler's theorem
+## sd.fm = sum(cr.fm) = sum(beta*mcr.fm)
+ if(is.matrix(beta.vec)) {
+ beta.names = c(rownames(beta.vec), "residual")
+ } else if(is.vector(beta.vec)) {
+ beta.names = c(names(beta.vec), "residual")
+ } else {
+ stop("beta.vec is not a matrix or a vector")
+ }
+ beta.vec = as.vector(beta.vec)
+ beta.star.vec = c(beta.vec, sqrt(sig2.e))
+ names(beta.star.vec) = beta.names
+ factor.cov = as.matrix(factor.cov)
+ k.star = length(beta.star.vec)
+ k = k.star - 1
+ factor.star.cov = diag(k.star)
+ factor.star.cov[1:k, 1:k] = factor.cov
+
+## compute factor model sd
+ sd.fm = as.numeric(sqrt(t(beta.star.vec) %*% factor.star.cov %*% beta.star.vec))
+## compute marginal and component contributions to sd
+ mcr.fm = (factor.star.cov %*% beta.star.vec)/sd.fm
+ cr.fm = mcr.fm * beta.star.vec
+ pcr.fm = cr.fm/sd.fm
+ rownames(mcr.fm) <- rownames(cr.fm) <- rownames(pcr.fm) <- beta.names
+ colnames(mcr.fm) = "MCR"
+ colnames(cr.fm) = "CR"
+ colnames(pcr.fm) = "PCR"
+## return results
+ ans = list(sd.fm = sd.fm,
+ mcr.fm = t(mcr.fm),
+ cr.fm = t(cr.fm),
+ pcr.fm = t(pcr.fm))
+ return(ans)
+}
+
Modified: pkg/FactorAnalytics/R/factorModelVaRDecomposition.R
===================================================================
--- pkg/FactorAnalytics/R/factorModelVaRDecomposition.R 2013-08-02 19:26:57 UTC (rev 2703)
+++ pkg/FactorAnalytics/R/factorModelVaRDecomposition.R 2013-08-02 21:32:20 UTC (rev 2704)
@@ -1,161 +1,161 @@
-#' Compute factor model factor VaR decomposition
-#'
-#' Compute factor model factor VaR decomposition based on Euler's theorem given
-#' historic or simulated data and factor model parameters. The partial
-#' derivative of VaR wrt factor beta is computed as the expected factor return
-#' given fund return is equal to its VaR and approximated by kernel estimator.
-#' VaR is compute either as the sample quantile or as an estimated quantile
-#' using the Cornish-Fisher expansion.
-#'
-#' The factor model has the form R(t) = beta'F(t) + e(t) = beta.star'F.star(t)
-#' where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))' By Euler's
-#' theorem VaR.fm = sum(cVaR.fm) = sum(beta.star*mVaR.fm)
-#'
-#' @param bootData B x (k+2) matrix of bootstrap data. First column contains
-#' the fund returns, second through k+1 columns contain factor returns, (k+2)nd
-#' column contain residuals scaled to have unit variance .
-#' @param beta.vec k x 1 vector of factor betas.
-#' @param sig2.e scalar, residual variance from factor model.
-#' @param tail.prob scalar, tail probability
-#' @param VaR.method character, method for computing VaR. Valid choices are
-#' "HS" for historical simulation (empirical quantile); "CornishFisher" for
-#' modified VaR based on Cornish-Fisher quantile estimate. Cornish-Fisher
-#' computation is done with the VaR.CornishFisher in the PerformanceAnalytics
-#' package.
-#' @return an S3 object containing
-#' @returnItem VaR.fm Scalar, bootstrap VaR value for fund reported as a
-#' positive number.
-#' @returnItem n.exceed Scalar, number of observations beyond VaR.
-#' @returnItem idx.exceed n.exceed x 1 vector giving index values of
-#' exceedences.
-#' @returnItem mVaR.fm (K+1) x 1 vector of factor marginal contributions to
-#' VaR.
-#' @returnItem cVaR.fm (K+1) x 1 vector of factor component contributions to
-#' VaR.
-#' @returnItem pcVaR.fm (K+1) x 1 vector of factor percent contributions to
-#' VaR.
-#' @author Eric Zivot and Yi-An Chen
-#' @references 1. Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A
-#' General Analysis", The Journal of Risk 5/2. 2. Yamai and Yoshiba (2002).
-#' "Comparative Analyses of Expected Shortfall and Value-at-Risk: Their
-#' Estimation Error, Decomposition, and Optimization Bank of Japan. 3. Meucci
-#' (2007). "Risk Contributions from Generic User-Defined Factors," Risk. 4.
-#' Epperlein and Smillie (2006) "Cracking VAR with Kernels," Risk.
-#' @examples
-#'
-#' data(managers.df)
-#' ret.assets = managers.df[,(1:6)]
-#' factors = managers.df[,(7:9)]
-#' # fit the factor model with OLS
-#' fit <- fitMacroeconomicFactorModel(ret.assets,factors,fit.method="OLS",
-#' variable.selection="all subsets",
-#' factor.set = 3)
-#'
-#' residualData=as.matrix(fit$residVars.vec,1,6)
-#' bootData <- factorModelMonteCarlo(n.boot=100, factors ,fit$beta.mat, residual.dist="normal",
-#' residualData, Alpha.mat=NULL, boot.method="random",
-#' seed = 123, return.factors = "TRUE", return.residuals = "TRUE")
-#'
-#' # compute risk factor contribution to VaR using bootstrap data
-#' # combine fund returns, factor returns and residual returns for HAM1
-#' tmpData = cbind(bootData$returns[,1], bootData$factors,
-#' bootData$residuals[,1]/sqrt(fit$residVars.vec[1]))
-#' colnames(tmpData)[c(1,5)] = c("HAM1", "residual")
-#' factor.VaR.decomp.HAM1 <- factorModelVaRDecomposition(tmpData, fit$beta.mat[1,],
-#' fit$residVars.vec[1], tail.prob=0.05,VaR.method="HS")
-#'
-#'
-factorModelVaRDecomposition <-
-function(bootData, beta.vec, sig2.e, tail.prob = 0.01,
- VaR.method=c("HS", "CornishFisher")) {
-## Compute factor model factor VaR decomposition based on Euler's theorem given historic
-## or simulated data and factor model parameters.
-## The partial derivative of VaR wrt factor beta is computed
-## as the expected factor return given fund return is equal to its VaR and approximated by kernel estimator.
-## VaR is compute either as the sample quantile or as an estimated quantile
-## using the Cornish-Fisher expansion.
-## inputs:
-## bootData B x (k+2) matrix of bootstrap data. First column contains the fund returns,
-## second through k+1 columns contain factor returns, (k+2)nd column contain residuals
-## scaled to have variance 1.
-## beta.vec k x 1 vector of factor betas
-## sig2.e scalar, residual variance from factor model
-## tail.prob scalar tail probability
-## method character, method for computing marginal ES. Valid choices are
-## "average" for approximating E[Fj | R=VaR]
-## VaR.method character, method for computing VaR. Valid choices are "HS" for
-## historical simulation (empirical quantile); "CornishFisher" for
-## modified VaR based on Cornish-Fisher quantile estimate. Cornish-Fisher
-## computation is done with the VaR.CornishFisher in the PerformanceAnalytics
-## package
-## output:
-## A list with the following components:
-## VaR.fm scalar, bootstrap VaR value for fund reported as a positive number
-## n.exceed scalar, number of observations beyond VaR
-## idx.exceed n.exceed x 1 vector giving index values of exceedences
-## mcES.fm k+1 x 1 vector of factor marginal contributions to ES
-## cES.fm k+1 x 1 vector of factor component contributions to ES
-## pcES.fm k+1 x 1 vector of factor percent contributions to ES
-## Remarks:
-## The factor model has the form
-## R(t) = beta'F(t) + e(t) = beta.star'F.star(t)
-## where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))'
-## By Euler's theorem
-## ES.fm = sum(cES.fm) = sum(beta.star*mcES.fm)
-## References:
-## 1. Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A General Analysis",
-## The Journal of Risk 5/2.
-## 2. Yamai and Yoshiba (2002). "Comparative Analyses of Expected Shortfall and
-## Value-at-Risk: Their Estimation Error, Decomposition, and Optimization
-## Bank of Japan.
-## 3. Meucci (2007). "Risk Contributions from Generic User-Defined Factors," Risk.
-
-
-require(PerformanceAnalytics)
- VaR.method = VaR.method[1]
- bootData = as.matrix(bootData)
- ncol.bootData = ncol(bootData)
- if(is.matrix(beta.vec)) {
- beta.names = c(rownames(beta.vec), "residual")
- } else if(is.vector(beta.vec)) {
- beta.names = c(names(beta.vec), "residual")
- } else {
- stop("beta.vec is not an n x 1 matrix or a vector")
- }
- beta.names = c(names(beta.vec), "residual")
- beta.star.vec = c(beta.vec, sqrt(sig2.e))
- names(beta.star.vec) = beta.names
-
- ## epsilon is calculated in the sense of minimizing mean square error by Silverman 1986
- epi <- 2.575*sd(bootData[,1]) * (nrow(bootData)^(-1/5))
- if (VaR.method == "HS") {
- VaR.fm = quantile(bootData[, 1], prob=tail.prob)
- idx = which(bootData[, 1] <= VaR.fm + epi & bootData[,1] >= VaR.fm - epi)
- } else {
- VaR.fm = as.numeric(VaR(bootData[, 1], p=(1-tail.prob),method="modified"))
- idx = which(bootData[, 1] <= VaR.fm + epi & bootData[,1] >= VaR.fm - epi)
- }
- ##
- ## compute marginal contribution to VaR
- ##
- ## compute marginal VaR as expected value of factor return given
- ## triangler kernel
- mVaR.fm = -as.matrix(colMeans(bootData[idx, -1]))
-
-## compute correction factor so that sum of weighted marginal VaR adds to portfolio VaR
-cf = as.numeric( -VaR.fm / sum(mVaR.fm*beta.star.vec) )
-mVaR.fm = cf*mVaR.fm
-cVaR.fm = mVaR.fm*beta.star.vec
-pcVaR.fm = cVaR.fm/-VaR.fm
-colnames(mVaR.fm) = "MVaR"
-colnames(cVaR.fm) = "CVaR"
-colnames(pcVaR.fm) = "PCVaR"
-ans = list(VaR.fm = -VaR.fm,
- n.exceed = length(idx),
- idx.exceed = idx,
- mVaR.fm = t(mVaR.fm),
- cVaR.fm = t(cVaR.fm),
- pcVaR.fm = t(pcVaR.fm))
-return(ans)
-}
-
+#' Compute factor model factor VaR decomposition
+#'
+#' Compute factor model factor VaR decomposition based on Euler's theorem given
+#' historic or simulated data and factor model parameters. The partial
+#' derivative of VaR wrt factor beta is computed as the expected factor return
+#' given fund return is equal to its VaR and approximated by kernel estimator.
+#' VaR is compute either as the sample quantile or as an estimated quantile
+#' using the Cornish-Fisher expansion.
+#'
+#' The factor model has the form R(t) = beta'F(t) + e(t) = beta.star'F.star(t)
+#' where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))' By Euler's
+#' theorem VaR.fm = sum(cVaR.fm) = sum(beta.star*mVaR.fm)
+#'
+#' @param bootData B x (k+2) matrix of bootstrap data. First column contains
+#' the fund returns, second through k+1 columns contain factor returns, (k+2)nd
+#' column contain residuals scaled to have unit variance .
+#' @param beta.vec k x 1 vector of factor betas.
+#' @param sig2.e scalar, residual variance from factor model.
+#' @param tail.prob scalar, tail probability
+#' @param VaR.method character, method for computing VaR. Valid choices are
+#' "HS" for historical simulation (empirical quantile); "CornishFisher" for
+#' modified VaR based on Cornish-Fisher quantile estimate. Cornish-Fisher
+#' computation is done with the VaR.CornishFisher in the PerformanceAnalytics
+#' package.
+#' @return an S3 object containing
+#' @returnItem VaR.fm Scalar, bootstrap VaR value for fund reported as a
+#' positive number.
+#' @returnItem n.exceed Scalar, number of observations beyond VaR.
+#' @returnItem idx.exceed n.exceed x 1 vector giving index values of
+#' exceedences.
+#' @returnItem mVaR.fm (K+1) x 1 vector of factor marginal contributions to
+#' VaR.
+#' @returnItem cVaR.fm (K+1) x 1 vector of factor component contributions to
+#' VaR.
+#' @returnItem pcVaR.fm (K+1) x 1 vector of factor percent contributions to
+#' VaR.
+#' @author Eric Zivot and Yi-An Chen
+#' @references 1. Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A
+#' General Analysis", The Journal of Risk 5/2. 2. Yamai and Yoshiba (2002).
+#' "Comparative Analyses of Expected Shortfall and Value-at-Risk: Their
+#' Estimation Error, Decomposition, and Optimization Bank of Japan. 3. Meucci
+#' (2007). "Risk Contributions from Generic User-Defined Factors," Risk. 4.
+#' Epperlein and Smillie (2006) "Cracking VAR with Kernels," Risk.
+#' @examples
+#'
+#' data(managers.df)
+#' ret.assets = managers.df[,(1:6)]
+#' factors = managers.df[,(7:9)]
+#' # fit the factor model with OLS
+#' fit <- fitMacroeconomicFactorModel(ret.assets,factors,fit.method="OLS",
+#' variable.selection="all subsets",
+#' factor.set = 3)
+#'
+#' residualData=as.matrix(fit$residVars.vec,1,6)
+#' bootData <- factorModelMonteCarlo(n.boot=100, factors ,fit$beta.mat, residual.dist="normal",
+#' residualData, Alpha.mat=NULL, boot.method="random",
+#' seed = 123, return.factors = "TRUE", return.residuals = "TRUE")
+#'
+#' # compute risk factor contribution to VaR using bootstrap data
+#' # combine fund returns, factor returns and residual returns for HAM1
+#' tmpData = cbind(bootData$returns[,1], bootData$factors,
+#' bootData$residuals[,1]/sqrt(fit$residVars.vec[1]))
+#' colnames(tmpData)[c(1,5)] = c("HAM1", "residual")
+#' factor.VaR.decomp.HAM1 <- factorModelVaRDecomposition(tmpData, fit$beta.mat[1,],
+#' fit$residVars.vec[1], tail.prob=0.05,VaR.method="HS")
+#'
+#' @export
+factorModelVaRDecomposition <-
+function(bootData, beta.vec, sig2.e, tail.prob = 0.01,
+ VaR.method=c("HS", "CornishFisher")) {
+## Compute factor model factor VaR decomposition based on Euler's theorem given historic
+## or simulated data and factor model parameters.
+## The partial derivative of VaR wrt factor beta is computed
+## as the expected factor return given fund return is equal to its VaR and approximated by kernel estimator.
+## VaR is compute either as the sample quantile or as an estimated quantile
+## using the Cornish-Fisher expansion.
+## inputs:
+## bootData B x (k+2) matrix of bootstrap data. First column contains the fund returns,
+## second through k+1 columns contain factor returns, (k+2)nd column contain residuals
+## scaled to have variance 1.
+## beta.vec k x 1 vector of factor betas
+## sig2.e scalar, residual variance from factor model
+## tail.prob scalar tail probability
+## method character, method for computing marginal ES. Valid choices are
+## "average" for approximating E[Fj | R=VaR]
+## VaR.method character, method for computing VaR. Valid choices are "HS" for
+## historical simulation (empirical quantile); "CornishFisher" for
+## modified VaR based on Cornish-Fisher quantile estimate. Cornish-Fisher
+## computation is done with the VaR.CornishFisher in the PerformanceAnalytics
+## package
+## output:
+## A list with the following components:
+## VaR.fm scalar, bootstrap VaR value for fund reported as a positive number
+## n.exceed scalar, number of observations beyond VaR
+## idx.exceed n.exceed x 1 vector giving index values of exceedences
+## mcES.fm k+1 x 1 vector of factor marginal contributions to ES
+## cES.fm k+1 x 1 vector of factor component contributions to ES
+## pcES.fm k+1 x 1 vector of factor percent contributions to ES
+## Remarks:
+## The factor model has the form
+## R(t) = beta'F(t) + e(t) = beta.star'F.star(t)
+## where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))'
+## By Euler's theorem
+## ES.fm = sum(cES.fm) = sum(beta.star*mcES.fm)
+## References:
+## 1. Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A General Analysis",
+## The Journal of Risk 5/2.
+## 2. Yamai and Yoshiba (2002). "Comparative Analyses of Expected Shortfall and
+## Value-at-Risk: Their Estimation Error, Decomposition, and Optimization
+## Bank of Japan.
+## 3. Meucci (2007). "Risk Contributions from Generic User-Defined Factors," Risk.
+
+
+require(PerformanceAnalytics)
+ VaR.method = VaR.method[1]
+ bootData = as.matrix(bootData)
+ ncol.bootData = ncol(bootData)
+ if(is.matrix(beta.vec)) {
+ beta.names = c(rownames(beta.vec), "residual")
+ } else if(is.vector(beta.vec)) {
+ beta.names = c(names(beta.vec), "residual")
+ } else {
+ stop("beta.vec is not an n x 1 matrix or a vector")
+ }
+ beta.names = c(names(beta.vec), "residual")
+ beta.star.vec = c(beta.vec, sqrt(sig2.e))
+ names(beta.star.vec) = beta.names
+
+ ## epsilon is calculated in the sense of minimizing mean square error by Silverman 1986
+ epi <- 2.575*sd(bootData[,1]) * (nrow(bootData)^(-1/5))
+ if (VaR.method == "HS") {
+ VaR.fm = quantile(bootData[, 1], prob=tail.prob)
+ idx = which(bootData[, 1] <= VaR.fm + epi & bootData[,1] >= VaR.fm - epi)
+ } else {
+ VaR.fm = as.numeric(VaR(bootData[, 1], p=(1-tail.prob),method="modified"))
+ idx = which(bootData[, 1] <= VaR.fm + epi & bootData[,1] >= VaR.fm - epi)
+ }
+ ##
+ ## compute marginal contribution to VaR
+ ##
+ ## compute marginal VaR as expected value of factor return given
+ ## triangler kernel
+ mVaR.fm = -as.matrix(colMeans(bootData[idx, -1]))
+
+## compute correction factor so that sum of weighted marginal VaR adds to portfolio VaR
+cf = as.numeric( -VaR.fm / sum(mVaR.fm*beta.star.vec) )
+mVaR.fm = cf*mVaR.fm
+cVaR.fm = mVaR.fm*beta.star.vec
+pcVaR.fm = cVaR.fm/-VaR.fm
+colnames(mVaR.fm) = "MVaR"
+colnames(cVaR.fm) = "CVaR"
+colnames(pcVaR.fm) = "PCVaR"
+ans = list(VaR.fm = -VaR.fm,
+ n.exceed = length(idx),
+ idx.exceed = idx,
+ mVaR.fm = t(mVaR.fm),
+ cVaR.fm = t(cVaR.fm),
+ pcVaR.fm = t(pcVaR.fm))
+return(ans)
+}
+
Modified: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-08-02 19:26:57 UTC (rev 2703)
+++ pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2013-08-02 21:32:20 UTC (rev 2704)
@@ -35,8 +35,6 @@
#' the data.
#' @param assetvar A character string giving the name of the asset variable in
#' the data.
-#' @param exposure.names A character string giving the name of the exposure variable in
-#' the data.
#' @return an S3 object containing
#' \itemize{
#' \item returns.cov A "list" object contains covariance information for
@@ -58,6 +56,8 @@
#' \item tstats A "xts" object containing the time series of t-statistics
#' for each exposure.
#' \item call function call
+#' \item exposure.names A character string giving the name of the exposure variable in
+#' the data.
#' }
#' @author Guy Yullen and Yi-An Chen
#' @examples
@@ -109,7 +109,7 @@
#'
#'
#' }
-#'
+#' @export
fitFundamentalFactorModel <-
Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2013-08-02 19:26:57 UTC (rev 2703)
+++ pkg/FactorAnalytics/R/fitStatisticalFactorModel.R 2013-08-02 21:32:20 UTC (rev 2704)
@@ -16,6 +16,8 @@
#' considered.
#' @param sig significant level when ck method uses.
#' @param na.rm if allow missing values. Default is FALSE.
+#'
+#'
#' @return
#' \itemize{
#' \item{factors}{T x K the estimated factors.}
@@ -75,9 +77,10 @@
#' names(sfm.apca.fit.ck)
#' sfm.apca.fit.ck$mimic
#'
+#' @export
+#'
fitStatisticalFactorModel <-
-function(data, k = 1, refine = TRUE, check = FALSE, max.k = NULL, sig = 0.05, na.rm = FALSE,
- ckeckData.method = "xts" ){
+function(data, k = 1, refine = TRUE, check = FALSE, max.k = NULL, sig = 0.05, na.rm = FALSE){
# load package
require(MASS)
@@ -226,15 +229,15 @@
dimnames(ret.cov) <- list(data.names, data.names)
names(alpha) <- data.names
- if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) {
+# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) {
f <- xts(f,index(data.xts))
resid <- xts(resid,index(data.xts))
- }
+# }
# create lm list for plot
reg.list = list()
- if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) {
+# if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) {
for (i in data.names) {
reg.xts = merge(data.xts[,i],f)
colnames(reg.xts)[1] <- i
@@ -242,15 +245,15 @@
fm.fit = lm(fm.formula, data=reg.xts)
reg.list[[i]] = fm.fit
}
- } else {
- for (i in data.names) {
- reg.df = as.data.frame(cbind(data[,i],coredata(f)))
- colnames(reg.df)[1] <- i
- fm.formula = as.formula(paste(i,"~", ".", sep=" "))
- fm.fit = lm(fm.formula, data=reg.df)
- reg.list[[i]] = fm.fit
- }
- }
+# } else {
+# for (i in data.names) {
+# reg.df = as.data.frame(cbind(data[,i],coredata(f)))
+# colnames(reg.df)[1] <- i
+# fm.formula = as.formula(paste(i,"~", ".", sep=" "))
+# fm.fit = lm(fm.formula, data=reg.df)
+# reg.list[[i]] = fm.fit
+# }
+# }
ans <- list(factors = f, loadings = B, k = k, alpha = alpha, ret.cov = ret.cov,
r2 = r2, eigen = eigen.tmp$values, residuals=resid, asset.ret = data,
@@ -305,14 +308,14 @@
resid <- t(t(data) - alpha) - f %*% B
r2 <- (1 - colSums(resid^2)/colSums(xc^2))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 2704
More information about the Returnanalytics-commits
mailing list