[Returnanalytics-commits] r3548 - in pkg/FactorAnalytics: R man sandbox vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Nov 14 20:47:14 CET 2014
Author: pragnya
Date: 2014-11-14 20:47:13 +0100 (Fri, 14 Nov 2014)
New Revision: 3548
Removed:
pkg/FactorAnalytics/R/factorModelEsDecomposition.R
pkg/FactorAnalytics/R/factorModelMonteCarlo.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/plot.StatFactorModel.r
pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r
pkg/FactorAnalytics/R/predict.StatFactorModel.r
pkg/FactorAnalytics/R/print.FundamentalFactorModel.r
pkg/FactorAnalytics/R/print.StatFactorModel.r
pkg/FactorAnalytics/R/summary.FundamentalFactorModel.r
pkg/FactorAnalytics/R/summary.StatFactorModel.r
pkg/FactorAnalytics/man/factorModelEsDecomposition.Rd
pkg/FactorAnalytics/man/factorModelMonteCarlo.Rd
pkg/FactorAnalytics/man/factorModelSdDecomposition.Rd
pkg/FactorAnalytics/man/factorModelVaRDecomposition.Rd
pkg/FactorAnalytics/man/fitFundamentalFactorModel.Rd
pkg/FactorAnalytics/man/fitStatisticalFactorModel.Rd
pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/plot.StatFactorModel.Rd
pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/predict.StatFactorModel.Rd
pkg/FactorAnalytics/man/print.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/print.StatFactorModel.Rd
pkg/FactorAnalytics/man/summary.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/summary.StatFactorModel.Rd
pkg/FactorAnalytics/sandbox/example.menu.plot.r
pkg/FactorAnalytics/sandbox/plotFactorModelFit.r
pkg/FactorAnalytics/sandbox/test.vignette.r
pkg/FactorAnalytics/sandbox/testfile.r
pkg/FactorAnalytics/vignettes/equity.Rdata
pkg/FactorAnalytics/vignettes/equity.csv
pkg/FactorAnalytics/vignettes/fundamentalFM.Rnw
pkg/FactorAnalytics/vignettes/fundamentalFM.pdf
Log:
Deleted outdated scripts, examples etc.
Deleted: pkg/FactorAnalytics/R/factorModelEsDecomposition.R
===================================================================
--- pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2014-11-03 22:39:10 UTC (rev 3547)
+++ pkg/FactorAnalytics/R/factorModelEsDecomposition.R 2014-11-14 19:47:13 UTC (rev 3548)
@@ -1,135 +0,0 @@
-#' Compute Factor Model ES Decomposition
-#'
-#' Compute the factor model factor expected shortfall (ES) decomposition for an
-#' asset based on Euler's theorem given historic or simulated data and factor
-#' model parameters. The partial derivative of ES with respect to factor beta
-#' is computed as the expected factor return given fund return is less than or
-#' equal to its value-at-risk (VaR). VaR is compute as the sample quantile of
-#' the historic or simulated data.
-#'
-#' The factor model has the form \cr
-#' \code{R(t) = beta'F(t) + e(t) = beta.star'F.star(t)}\cr
-#' where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))' By Euler's
-#' theorem: \cr \code{ES.fm = sum(cES.fm) = sum(beta.star*mES.fm)} \cr
-#'
-#' @param Data \code{B x (k+2)} matrix of historic or simulated data. The first
-#' column contains the fund returns, the second through \code{k+1}st columns
-#' contain the returns on the \code{k} factors, and the \code{(k+2)}nd column
-#' contain residuals scaled to have unit variance.
-#' @param beta.vec \code{k x 1} vector of factor betas.
-#' @param sig.e scalar, residual variance from factor model.
-#' @param tail.prob scalar, tail probability for VaR quantile. Typically 0.01
-#' or 0.05.
-#' @param VaR.method character, method for computing VaR. Valid choices are
-#' one of "modified","gaussian","historical", "kernel". computation is done
-#' with the \code{VaR} in the PerformanceAnalytics package.
-#'
-#'
-#' @return A list with the following components:
-#' \itemize{
-#' \item{VaR} {Scalar, nonparametric VaR value for fund reported as a
-#' positive number.}
-#' \item{n.exceed} Scalar, number of observations beyond VaR.
-#' \item{idx.exceed} n.exceed x 1 vector giving index values of exceedences.
-#' \item{ES.fm} Scalar. nonparametric ES value for fund reported as a positive
-#' number.
-#' \item{mES.fm} (K+1) x 1 vector of factor marginal contributions to ES.
-#' \item{cES.fm} (K+1) x 1 vector of factor component contributions to ES.
-#' \item{pcES.fm} (K+1) x 1 vector of factor percentage component contributions
-#' to ES.
-#' }
-#' @author Eric Zviot and Yi-An Chen.
-#' @references \enumerate{
-#' \item Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A
-#' General Analysis", The Journal of Risk 5/2.
-#' \item Yamai and Yoshiba (2002)."Comparative Analyses of Expected Shortfall
-#' and Value-at-Risk: Their
-#' Estimation Error, Decomposition, and Optimization Bank of Japan.
-#' \item Meucci (2007). "Risk Contributions from Generic User-Defined Factors".
-#' \item Epperlein and Smillie (2006) "Cracking VAR with Kernels," Risk.
-#' }
-#' @examples
-#' \dontrun{
-#' data(managers)
-#' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]),
-#' factor.names=c("EDHEC LS EQ","SP500 TR"),data=managers)
-#' # risk factor contribution to ETL
-#' # combine fund returns, factor returns and residual returns for HAM1
-#' tmpData = cbind(managers[,1],managers[,c("EDHEC LS EQ","SP500 TR")] ,
-#' residuals(fit.macro$asset.fit$HAM1)/sqrt(fit.macro$resid.sd[1]))
-#' colnames(tmpData)[c(1,4)] = c("HAM1", "residual")
-#' factor.es.decomp.HAM1 = factorModelEsDecomposition(tmpData, fit.macro$beta[1,],
-#' fit.macro$resid.sd[1], tail.prob=0.05,
-#' VaR.method="historical" )
-#'
-#' # fundamental factor model
-#' # try to find factor contribution to ES for STI
-#' data(Stock.df)
-#' 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)
-#' idx <- fit.fund$data[,fit.fund$assetvar] == "STI"
-#' asset.ret <- fit.fund$data[idx,fit.fund$returnsvar]
-#' tmpData = cbind(asset.ret, fit.fund$factor.returns,
-#' fit.fund$residuals[,"STI"]/sqrt(fit.fund$resid.variance["STI"]) )
-#' colnames(tmpData)[c(1,length(tmpData[1,]))] = c("STI", "residual")
-#' factorModelEsDecomposition(tmpData,
-#' fit.fund$beta["STI",],
-#' fit.fund$resid.variance["STI"], tail.prob=0.05,VaR.method="historical")
-#' }
-#'
-#' @export
-#'
-factorModelEsDecomposition <-
-function(Data, beta.vec, sig.e, tail.prob = 0.05,
- VaR.method=c("modified", "gaussian", "historical", "kernel")) {
-
- Data = as.matrix(Data)
- ncol.Data = ncol(Data)
- 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, sig.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(Data[,1]) * (nrow(Data)^(-1/5))
- VaR.fm = as.numeric(VaR(Data[, 1], p=(1-tail.prob),method=VaR.method))
- idx = which(Data[, 1] <= VaR.fm + epi & Data[,1] >= VaR.fm - epi)
-
-
-
- ES.fm = -mean(Data[idx, 1])
-
- ##
- ## compute marginal contribution to ES
- ##
- ## compute marginal ES as expected value of factor return given fund
- ## return is less than or equal to VaR
- mcES.fm = -as.matrix(colMeans(Data[idx, -1]))
-
-## compute correction factor so that sum of weighted marginal ES adds to portfolio ES
-cf = as.numeric( ES.fm / sum(mcES.fm*beta.star.vec) )
-mcES.fm = cf*mcES.fm
-cES.fm = mcES.fm*beta.star.vec
-pcES.fm = cES.fm/ES.fm
-colnames(mcES.fm) = "MCES"
-colnames(cES.fm) = "CES"
-colnames(pcES.fm) = "PCES"
-ans = list(VaR.fm = -VaR.fm,
- n.exceed = length(idx),
- idx.exceed = idx,
- ES.fm = ES.fm,
- mES.fm = t(mcES.fm),
- cES.fm = t(cES.fm),
- pcES.fm = t(pcES.fm))
-return(ans)
-}
-
Deleted: pkg/FactorAnalytics/R/factorModelMonteCarlo.R
===================================================================
--- pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2014-11-03 22:39:10 UTC (rev 3547)
+++ pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2014-11-14 19:47:13 UTC (rev 3548)
@@ -1,155 +0,0 @@
-#' Simulate returns using factor model Monte Carlo method.
-#'
-#' Simulate returns using factor model Monte Carlo method. Parametric method
-#' like normal distribution, Cornish-Fisher and skew-t distribution for
-#' residuals can be selected. Resampling method such as non-parametric bootstrap
-#' or stationary bootstrap can be selected.
-#'
-#' The factor model Monte Carlo method is described in Jiang (2009).
-#'
-#' @param n.boot Integer number of bootstrap samples.
-#' @param factorData \code{n.months x n.funds} matrix or data.frame of factor
-#' returns.
-#' @param Beta.mat \code{n.funds x n.factors} matrix of factor betas.
-#' @param Alpha.mat \code{n.funds x 1} matrix of factor alphas (intercepts). If
-#' \code{NULL} then assume that all alphas are zero.
-#' @param residualData \code{n.funds x n.parms} matrix of residual distribution
-#' parameters. The columns of \code{residualData} depend on the value of
-#' \code{residual.dist}. If \code{residual.dist = "normal"}, then
-#' \code{residualData} has one column containing variance values; if
-#' \code{residual.dist = "Cornish-Fisher"}, then \code{residualData} has three
-#' columns containing variance, skewness and excess kurtosis values; if
-#' \code{residual.dist="skew-t"}, then \code{residualData} has four columns
-#' containing location, scale, shape, and df values.
-#' @param residual.dist character vector specifying the residual distribution.
-#' Choices are "normal" for the normal distribution; "Cornish-Fisher" for the
-#' Cornish-Fisher distribution based on the Cornish-Fisher expansion of the
-#' normal distribution quantile; "skew-t" for the skewed Student's t
-#' distribution of Azzalini and Captiano.
-#' @param boot.method character vector specifying the resampling method.
-#' Choices are "random" for random sampling with replacement (non-parametric
-#' bootstrap); "block" for stationary block bootstrapping.
-#' @param seed integer random number seed used for resampling the factor
-#' returns.
-#' @param return.factors logical; if \code{TRUE} then return resampled factors
-#' in output list object.
-#' @param return.residuals logical; if \code{TRUE} then return simulated
-#' residuals in output list object.
-#' @return A list with the following components:
-#' \itemize{
-#' \item{returns} \code{n.boot x n.funds} matrix of simulated fund
-#' returns.
-#' \item{factors} \code{n.boot x n.factors} matrix of resampled factor
-#' returns. Returned only if \code{return.factors = TRUE}.
-#' \item{residuals} \code{n.boot x n.funds} matrix of simulated fund
-#' residuals. Returned only if \code{return.residuals = TRUE}.
-#' }
-#' @author Eric Zivot and Yi-An Chen.
-#' @references Jiang, Y. (2009). UW PhD Thesis.
-#' @export
-#' @examples
-#'
-#' # load data from the database
-#' \dontrun{
-#' data(managers)
-#' fit <- fitTsfm(asset.names=colnames(managers[,(1:6)]),
-#' factor.names=c("EDHEC LS EQ","SP500 TR"), data=managers)
-#' factorData= managers[,c("EDHEC LS EQ","SP500 TR")]
-#' Beta.mat=fit$beta
-#' residualData=as.matrix((fit$resid.sd)^2,1,6)
-#' n.boot=1000
-#' # bootstrap returns data from factor model with residuals sample from normal distribution
-#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="normal",
-#' residualData, Alpha.mat=NULL, boot.method="random",
-#' seed = 123, return.factors = "TRUE", return.residuals =
-#' "TRUE")
-#' # Cornish-Fisher distribution
-#' # build different residualData matrix
-#' residualData <- cbind(c(1,2,1,3,0.1,0.5),rnorm(6),c(2,3,1,2,1,0))
-#' colnames(residualData) <- c("var","skew","ekurt")
-#' rownames(residualData) <- colnames(managers[,(1:6)])
-#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="Cornish-Fisher",
-#' residualData, Alpha.mat=NULL, boot.method="random",
-#' seed = 123, return.factors = "TRUE", return.residuals =
-#' "TRUE")
-#'
-#'
-#' # skew-t distribution
-#' # build residualData matrix
-#' residualData <- cbind(rnorm(6),c(1,2,1,3,0.1,0.5),rnorm(6),c(2,3,1,6,10,100))
-#' colnames(residualData) <- c("xi","omega","alpha","nu")
-#' rownames(residualData) <- colnames(managers[,(1:6)])
-#' bootData <- factorModelMonteCarlo(n.boot, factorData,Beta.mat, residual.dist="skew-t",
-#' residualData, Alpha.mat=NULL, boot.method="random",
-#' seed = 123, return.factors = "TRUE", return.residuals =
-#' "TRUE")
-#' }
-#'
-factorModelMonteCarlo <-
- function (n.boot = 1000, factorData, Beta.mat, Alpha.mat = NULL,
- residualData, residual.dist = c("normal", "Cornish-Fisher",
- "skew-t"), boot.method = c("random", "block"), seed = 123,
- return.factors = FALSE, return.residuals = FALSE)
- {
- boot.method = boot.method[1]
- residual.dist = residual.dist[1]
- set.seed(seed)
- if (nrow(Beta.mat) != nrow(residualData)) {
- stop("Beta.mat and residualData have different number of rows")
- }
- factorData = as.matrix(factorData)
- n.funds = nrow(Beta.mat)
- fund.names = rownames(Beta.mat)
- if (is.null(Alpha.mat)) {
- Alpha.mat = matrix(0, nrow(Beta.mat))
- rownames(Alpha.mat) = fund.names
- }
- if (boot.method == "random") {
- bootIdx = sample(nrow(factorData), n.boot, replace = TRUE)
- }
- else {
- n.samples = round(n.boot/nrow(factorData))
- n.adj = n.boot - n.samples * nrow(factorData)
- bootIdx = as.vector(tsbootstrap(1:nrow(factorData), nb = n.samples))
- if (n.adj > 0) {
- bootIdx = c(bootIdx, bootIdx[1:n.adj])
- }
- }
- factorDataBoot = factorData[bootIdx, ]
- fundReturnsBoot = matrix(0, n.boot, n.funds)
- residualsSim = matrix(0, n.boot, n.funds)
- colnames(fundReturnsBoot) = colnames(residualsSim) = fund.names
- for (i in fund.names) {
- set.seed(which(fund.names == i))
- if (residual.dist == "normal") {
- residualsSim[, i] = rnorm(n.boot, sd = sqrt(residualData[i,
- ]))
- }
- else if (residual.dist == "Cornish-Fisher") {
- residualsSim[, i] = rCornishFisher(n.boot, sigma = sqrt(residualData[i,
- "var"]), skew = residualData[i, "skew"], ekurt = residualData[i,
- "ekurt"])
- }
- else if (residual.dist == "skew-t") {
- residualsSim[, i] = rst(n.boot, xi = residualData[i,
- "xi"], omega = residualData[i, "omega"],
- alpha = residualData[i, "alpha"], nu = residualData[i,
- "nu"])
- }
- else {
- stop("Invalid residual distribution")
- }
- fundReturnsBoot[, i] = Alpha.mat[i, 1] + factorDataBoot[,
- colnames(Beta.mat)] %*% t(Beta.mat[i, , drop = FALSE]) +
- residualsSim[, i]
- }
- ans = list(returns = fundReturnsBoot)
- if (return.factors) {
- ans$factors = factorDataBoot
- }
- if (return.residuals) {
- ans$residuals = residualsSim
- }
- return(ans)
- }
-
Deleted: pkg/FactorAnalytics/R/factorModelSdDecomposition.R
===================================================================
--- pkg/FactorAnalytics/R/factorModelSdDecomposition.R 2014-11-03 22:39:10 UTC (rev 3547)
+++ pkg/FactorAnalytics/R/factorModelSdDecomposition.R 2014-11-14 19:47:13 UTC (rev 3548)
@@ -1,89 +0,0 @@
-#' Compute factor model standard deviation decomposition
-#'
-#' Compute the factor model factor standard deviation decomposition for an
-#' asset based on Euler's theorem given factor model parameters.
-#'
-#' The factor model has the form \cr \code{R(t) = beta'F(t) + e(t) = beta.star'F.star(t)}\cr
-#' where beta.star = (beta, sig.e)' and F.star(t) = [F(t)', z(t)]'. By Euler's
-#' theorem:\cr \code{Sd.fm = sum(cSd.fm) = sum(beta.star*mSd.fm)} \cr
-#'
-#'
-#' @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
-#' \itemize{
-#' \item{Sd.fm} Scalar, std dev based on factor model.
-#' \item{mSd.fm} (K+1) x 1 vector of factor marginal contributions to sd.
-#' \item{cSd.fm} (K+1) x 1 vector of factor component contributions to sd.
-#' \item{pcSd.fm} (K+1) x 1 vector of factor percentage component contributions to sd.
-#' }
-#' @author Eric Zivot and Yi-An Chen
-#' @references
-#' \enumerate{
-#' \item Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A
-#' General Analysis", The Journal of Risk 5/2.
-#' \item Yamai and Yoshiba (2002)."Comparative Analyses of Expected Shortfall and Value-at-Risk: Their
-#' Estimation Error, Decomposition, and Optimization Bank of Japan.
-#' \item Meucci (2007). "Risk Contributions from Generic User-Defined Factors," Risk.
-#' }#'
-#' @examples
-#'
-#' # load data from the database
-#' data("stat.fm.data")
-#' fit.stat <- fitStatisticalFactorModel(sfm.dat,k=2)
-#' cov.factors = var(fit.stat$factors)
-#' names = colnames(fit.stat$asset.ret)
-#' factor.sd.decomp.list = list()
-#' for (i in names) {
-#' factor.sd.decomp.list[[i]] =
-#' factorModelSdDecomposition(fit.stat$loadings[,i],
-#' cov.factors, fit.stat$resid.variance[i])
-#' }
-#'
-#' @export
-#'
-factorModelSdDecomposition <-
-function(beta.vec, factor.cov, sig2.e) {
-
-## 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,
- mSd.fm = t(mcr.fm),
- cSd.fm = t(cr.fm),
- pcSd.fm = t(pcr.fm))
- return(ans)
-}
-
Deleted: pkg/FactorAnalytics/R/factorModelVaRDecomposition.R
===================================================================
--- pkg/FactorAnalytics/R/factorModelVaRDecomposition.R 2014-11-03 22:39:10 UTC (rev 3547)
+++ pkg/FactorAnalytics/R/factorModelVaRDecomposition.R 2014-11-14 19:47:13 UTC (rev 3548)
@@ -1,104 +0,0 @@
-#' Compute factor model 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 \cr \code{R(t) = beta'F(t) + e(t) = beta.star'F.star(t)}\cr
-#' where beta.star = (beta, sig.e)' and F.star(t) = (F(t)', z(t))' By Euler's
-#' theorem:\cr \code{VaR.fm = sum(cVaR.fm) = sum(beta.star*mVaR.fm)} \cr
-#'
-#' @param Data 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
-#' one of "modified","gaussian","historical", "kernel". computation is done with the \code{VaR}
-#' in the PerformanceAnalytics package.
-#' @return an S3 object containing
-#' \itemize{
-#' \item{VaR.fm} Scalar, bootstrap VaR value for fund reported as a
-#' positive number.
-#' \item{n.exceed} Scalar, number of observations beyond VaR.
-#' \item{idx.exceed} n.exceed x 1 vector giving index values of
-#' exceedences.
-#' \item{mVaR.fm} (K+1) x 1 vector of factor marginal contributions to VaR.
-#' \item{cVaR.fm} (K+1) x 1 vector of factor component contributions to VaR.
-#' \item{pcVaR.fm} (K+1) x 1 vector of factor percentage contributions to VaR.
-#' }
-#' @author Eric Zivot and Yi-An Chen
-#' @references
-#' \enumerate{
-#' \item Hallerback (2003), "Decomposing Portfolio Value-at-Risk: A
-#' General Analysis", The Journal of Risk 5/2.
-#' \item Yamai and Yoshiba (2002)."Comparative Analyses of Expected Shortfall and Value-at-Risk: Their
-#' Estimation Error, Decomposition, and Optimization Bank of Japan.
-#' \item Meucci (2007). "Risk Contributions from Generic User-Defined Factors," Risk.
-#' }
-#' @examples
-#' \dontrun{
-#' data(managers)
-#' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]),
-#' factor.names=c("EDHEC LS EQ","SP500 TR"), data=managers)
-#' # risk factor contribution to VaR
-#' # combine fund returns, factor returns and residual returns for HAM1
-#' tmpData = cbind(managers[,1], managers[,c("EDHEC LS EQ","SP500 TR")] ,
-#' residuals(fit.macro$asset.fit$HAM1)/fit.macro$resid.sd[1])
-#' colnames(tmpData)[c(1,4)] = c("HAM1", "residual")
-#' factor.VaR.decomp.HAM1 = factorModelVaRDecomposition(tmpData, fit.macro$beta[1,],
-#' fit.macro$resid.sd[1], tail.prob=0.05,
-#' VaR.method="historical")
-#' }
-#' @export
-factorModelVaRDecomposition <-
-function(Data, beta.vec, sig2.e, tail.prob = 0.01,
- VaR.method=c("modified", "gaussian", "historical", "kernel")) {
-
- VaR.method = VaR.method[1]
- Data = as.matrix(Data)
- ncol.Data = ncol(Data)
- 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(Data[,1]) * (nrow(Data)^(-1/5))
- VaR.fm = as.numeric(VaR(Data[, 1], p=(1-tail.prob),method=VaR.method))
- idx = which(Data[, 1] <= VaR.fm + epi & Data[,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(Data[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)
-}
-
Deleted: pkg/FactorAnalytics/R/fitFundamentalFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2014-11-03 22:39:10 UTC (rev 3547)
+++ pkg/FactorAnalytics/R/fitFundamentalFactorModel.R 2014-11-14 19:47:13 UTC (rev 3548)
@@ -1,493 +0,0 @@
-#' @title Fit a fundamental factor model using classic OLS or Robust regression
-#'
-#' @description Fit a fundamental (cross-sectional) factor model using Ordinary
-#' Least Squares (OLS) or Robust regression. Fundamental factor models use
-#' observable asset specific characteristics (fundamentals) like industry
-#' classification, market capitalization, style classification (value, growth)
-#' etc. to calculate the common risk factors. An object of class \code{"ffm"}
-#' is returned.
-#'
-#' @details
-#' If style factor exposure is standardized to have a regression-weighted mean
-#' of zero, style factors become orthogonal to the world factor (intercept
-#' term), which in turn facilitates the interpretation of the style factor
-#' returns. See Menchero (2010).
-#'
-#' The original function was designed by Doug Martin and initially implemented
-#' in S-PLUS by a number of University of Washington Ph.D. students:
-#' Christopher Green, Eric Aldrich, and Yindeng Jiang. Guy Yollin
-#' re-implemented the function in R. Yi-An Chen and Sangeetha Srinivasan
-#' (UW PhD students; as part of Google Summer of Code 2013 & 2014 respectively)
-#' further updated the code.
-#'
-#'
-#' @param data data.frame, data must have \emph{assetvar}, \emph{returnvar},
-#' \emph{datevar}, and exposure.names. Generally, data has to look like panel
-#' data. It needs firm variabales and time variables. Data has to be a balanced
-#' panel.
-#' @param exposure.names a character vector of exposure names for the factor
-#' model
-#' @param wls logical flag, TRUE for weighted least squares, FALSE for ordinary
-#' least squares
-#' @param regression A character string, "robust" for regression via lmRob,
-#' "classic" for regression with lm()
-#' @param covariance A character string, "robust" for covariance matrix
-#' computed with covRob(), "classic" for covariance matrix with covClassic() in
-#' robust package.
-#' @param full.resid.cov logical flag, TRUE for full residual covariance matrix
-#' calculation, FALSE for diagonal residual covarinace matrix
-#' @param robust.scale logical flag, TRUE for exposure scaling via robust scale
-#' and location, FALSE for scaling via mean and sd
-#' @param returnsvar A character string giving the name of the return variable
-#' in the data.
-#' @param datevar A character string gives the name of the date variable in
-#' the data.
-#' @param assetvar A character string gives the name of the asset variable in
-#' the data.
-#' @param standardized.factor.exposure logical flag. Factor exposure will be
-#' standardized to regression weighted mean 0 and standardized deviation to 1
-#' if \code{TRUE}. Default is \code{FALSE}. See Details.
-#' @param weight.var A character strping gives the name of the weight used for
-#' standarizing factor exposures.
-#'
-#' @return An object of class \code{"ffm"} is a list containing the following
-#' components:
-#' \item{returns.cov}{A "list" object contains covariance information for
-#' asset returns, includes covariance, mean and eigenvalus. Beta of taken as
-#' latest date input.}
-#' \item{factor.cov}{An object of class "cov" or "covRob" which contains the
-#' covariance matrix of the factor returns (including intercept).}
-#' \item{resids.cov}{An object of class "cov" or "covRob" which contains
-#' the covariance matrix of the residuals, if "full.resid.cov" is TRUE. NULL
-#' if "full.resid.cov" is FALSE.}
-#' \item{returns.corr}{Correlation matrix of assets returns.}
-#' \item{factor.corr}{An object of class "cov" or "covRob" which contains the
-#' correlation matrix of the factor returns (including intercept).}
-#' \item{resids.corr}{Correlation matrix of returns returns.}
-#' \item{resid.variance}{A vector of variances estimated from the OLS
-#' residuals for each asset. If "wls" is TRUE, these are the weights used in
-#' the weighted least squares regressions. If "cov = robust" these values are
-#' computed with "scale.tau". Otherwise they are computed with "var".}
-#' \item{factor.returns}{A "xts" object containing the times series of
-#' estimated factor returns and intercepts.}
-#' \item{residuals}{A "xts" object containing the time series of residuals for
-#' each asset.}
-#' \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 Yollin, Yi-An Chen and Sangeetha Srinivasan
-#'
-#' @references
-#' Menchero, J. (2010). The Characteristics of Factor Portfolios. Journal of
-#' Performance Measurement, 15(1), 52-62.
-#'
-#' Grinold, R. C., & Kahn, R. N. (2000). Active portfolio management (Second
-#' Ed.). New York: McGraw-Hill.
-#'
-#' @examples
-#'
-#' # BARRA type factor model
-#' data(Stock.df)
-#' # there are 447 assets
-#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP")
-#' test.fit <- fitFundamentalFactorModel(data=stock,exposure.names=exposure.names,
-#' datevar = "DATE", returnsvar = "RETURN",
-#' assetvar = "TICKER", wls = TRUE,
-#' regression = "classic",
-#' covariance = "classic", full.resid.cov = TRUE,
-#' robust.scale = TRUE)
-#'
-#' names(test.fit)
-#' test.fit$returns.cov
-#' test.fit$resids.cov
-#' names(test.fit$cov.factor)
-#' test.fit$factor.cov$cov
-#' test.fit$factor
-#' test.fit$resid.variance
-#' test.fit$resids
-#' test.fit$tstats
-#' test.fit$call
-#'
-#' # BARRA type Industry Factor Model
-#' exposure.names <- c("GICS.SECTOR")
-#' # the rest keep the same
-#' test.fit2 <- fitFundamentalFactorModel(data=stock,exposure.names=exposure.names,
-#' datevar = "DATE", returnsvar = "RETURN",
-#' assetvar = "TICKER", wls = TRUE,
-#' regression = "classic",
-#' covariance = "classic", full.resid.cov = TRUE,
-#' robust.scale = TRUE)
-#'
-#' names(test.fit2)
-#' test.fit2$cov.returns
-#' test.fit2$cov.resids
-#' names(test.fit2$cov.factor)
-#' test.fit2$cov.factor$cov
-#' test.fit2$factor
-#' test.fit2$resid.variance
-#' test.fit2$resids
-#' test.fit2$tstats
-#' test.fit2$call
-#'
-#' @export
-
-fitFundamentalFactorModel <- function(data, exposure.names, datevar,
- returnsvar, assetvar, wls=TRUE,
- regression="classic",
- covariance="classic",
- full.resid.cov=FALSE, robust.scale=FALSE,
- standardized.factor.exposure=FALSE,
- weight.var) {
-
- assets = unique(data[[assetvar]])
- timedates = as.Date(unique(data[[datevar]]))
- data[[datevar]] <- as.Date(data[[datevar]])
-
- if (length(timedates) < 2)
- stop("At least two time points, t and t-1, are needed for fitting the factor model.")
- if (!is(exposure.names, "vector") || !is.character(exposure.names))
- stop("exposure argument invalid---must be character vector.")
- if (!is(assets, "vector") || !is.character(assets))
- stop("assets argument invalid---must be character vector.")
-
- wls <- as.logical(wls)
- full.resid.cov <- as.logical(full.resid.cov)
- robust.scale <- as.logical(robust.scale)
- standardized.factor.exposure <- as.logical(standardized.factor.exposure)
-
- if (!match(regression, c("robust", "classic"), FALSE))
- stop("regression must one of 'robust', 'classic'.")
- if (!match(covariance, c("robust", "classic"), FALSE))
- stop("covariance must one of 'robust', 'classic'.")
- this.call <- match.call()
-
- if (match(returnsvar, exposure.names, FALSE))
- stop(paste(returnsvar, "cannot be used as an exposure."))
-
-
- numTimePoints <- length(timedates)
- numExposures <- length(exposure.names)
- numAssets <- length(assets)
-
-
-
-
- # check if exposure.names are numeric, if not, create exposures. factors by dummy variables
- which.numeric <- sapply(data[, exposure.names, drop = FALSE],is.numeric)
- exposures.numeric <- exposure.names[which.numeric]
- # industry factor model
- exposures.factor <- exposure.names[!which.numeric]
- if (length(exposures.factor) > 1) {
- stop("Only one nonnumeric variable can be used at this time.")
- }
-
- if (standardized.factor.exposure == TRUE) {
- if (is.na(weight.var)) {
- stop("Need to assign weight variable")
- }
- weight = by(data = data, INDICES = as.numeric(data[[datevar]]),
- function(x) x[[weight.var]]/sum(x[[weight.var]]))
- data[[weight.var]] <- unlist(weight)
-
- for (i in exposures.numeric) {
- standardized.exposure <- by(data = data, INDICES = as.numeric(data[[datevar]]),
- function(x) ((x[[i]] - mean(x[[weight.var]]*x[[i]]) )*1/sd(x[[weight.var]]*x[[i]]) ))
- data[[i]] <- unlist(standardized.exposure)
- }
- }
-
-
- regression.formula <- paste("~", paste(exposure.names, collapse = "+"))
- # "~ BOOK2MARKET"
- if (length(exposures.factor)) {
- regression.formula <- paste(regression.formula, "- 1")
- data[, exposures.factor] <- as.factor(data[,exposures.factor])
- exposuresToRecode <- names(data[, exposure.names, drop = FALSE])[!which.numeric]
- contrasts.list <- lapply(seq(length(exposuresToRecode)),
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3548
More information about the Returnanalytics-commits
mailing list