From noreply at r-forge.r-project.org Thu Aug 4 14:36:18 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 4 Aug 2016 14:36:18 +0200 (CEST) Subject: [Returnanalytics-commits] r4024 - in pkg/FactorAnalytics: . R man Message-ID: <20160804123618.8F9371874B9@r-forge.r-project.org> Author: pragnya Date: 2016-08-04 14:36:18 +0200 (Thu, 04 Aug 2016) New Revision: 4024 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/R/plot.sfm.r pkg/FactorAnalytics/man/plot.sfm.Rd Log: Updated plot.sfm to display fitted parameters on plot Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2016-05-23 14:17:41 UTC (rev 4023) +++ pkg/FactorAnalytics/DESCRIPTION 2016-08-04 12:36:18 UTC (rev 4024) @@ -1,8 +1,8 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.33 -Date: 2016-05-23 +Version: 2.0.34 +Date: 2016-08-04 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Description: Linear factor model fitting for asset returns (three major types- Modified: pkg/FactorAnalytics/R/plot.sfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.sfm.r 2016-05-23 14:17:41 UTC (rev 4023) +++ pkg/FactorAnalytics/R/plot.sfm.r 2016-08-04 12:36:18 UTC (rev 4024) @@ -89,7 +89,7 @@ #' is \code{TRUE}. #' @param ... further arguments to be passed to other plotting functions. #' -#' @author Eric Zivot, Sangeetha Srinivasan and Yi-An Chen +#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan #' #' @seealso \code{\link{fitSfm}}, \code{\link{residuals.sfm}}, #' \code{\link{fitted.sfm}}, \code{\link{fmCov.sfm}} and @@ -171,9 +171,9 @@ den <- density(Residuals) xval <- den$x den.norm <- dnorm(xval, mean=mean(Residuals), sd=resid.sd) - den.st <- dst(xval, dp=st.mple(x=matrix(1,nrow(Residuals)), - y=as.vector(Residuals), opt.method="BFGS")$dp) - + dp.st <- st.mple(x=matrix(1,nrow(Residuals)), y=as.vector(Residuals), opt.method="BFGS")$dp + den.st <- dst(xval, dp=dp.st) + dp.st <- signif(dp.st, 2) # plot selection repeat { if (is.null(which)) { @@ -270,6 +270,8 @@ lines(xval, den.norm, col=colorset[2], lwd=lwd, lty="dashed") legend(x=legend.loc, lty=c("solid","dashed"), col=c(colorset[1:2]), lwd=lwd, bty="n", legend=c("KDE","Normal")) + mtext(text=paste("Normal (mu=",round(mean(Residuals),4),", sd=", + round(resid.sd,4),")",sep=""), side=3, line=0.25, cex=0.8) }, "12L" = { ## Non-parametric density of residuals with skew-t overlaid ymax <- ceiling(max(0,den$y,den.st)) @@ -279,6 +281,8 @@ lines(xval, den.st, col=colorset[2], lty="dashed", lwd=lwd) legend(x=legend.loc, lty=c("solid","dashed"), col=c(colorset[1:2]), lwd=lwd, bty="n", legend=c("KDE","Skew-t")) + mtext(text=paste("Skew-t (xi=",dp.st[1],", omega=",dp.st[2],", alpha=",dp.st[3], + ", nu=",dp.st[4],")",sep=""), side=3, line=0.25, cex=0.8) }, "13L" = { ## Histogram of residuals with non-parametric density and normal overlaid methods <- c("add.density","add.normal","add.rug") @@ -287,6 +291,8 @@ lwd=lwd, main=paste("Histogram of residuals:",i), ...) legend(x=legend.loc, col=colorset[c(2,3)], lwd=lwd, bty="n", legend=c("KDE","Normal")) + mtext(text=paste("Normal (mu=",round(mean(Residuals),4),", sd=", + round(resid.sd,4),")",sep=""), side=3, line=0.25, cex=0.8) }, "14L" = { ## QQ-plot of residuals chart.QQPlot(Residuals, envelope=0.95, col=colorset[1:2], lwd=lwd, Modified: pkg/FactorAnalytics/man/plot.sfm.Rd =================================================================== --- pkg/FactorAnalytics/man/plot.sfm.Rd 2016-05-23 14:17:41 UTC (rev 4023) +++ pkg/FactorAnalytics/man/plot.sfm.Rd 2016-08-04 12:36:18 UTC (rev 4024) @@ -141,7 +141,7 @@ } \author{ -Eric Zivot, Sangeetha Srinivasan and Yi-An Chen +Eric Zivot, Yi-An Chen and Sangeetha Srinivasan } \seealso{ \code{\link{fitSfm}}, \code{\link{residuals.sfm}}, From noreply at r-forge.r-project.org Thu Aug 4 14:55:43 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 4 Aug 2016 14:55:43 +0200 (CEST) Subject: [Returnanalytics-commits] r4025 - in pkg/FactorAnalytics: . R man Message-ID: <20160804125543.737511872EB@r-forge.r-project.org> Author: pragnya Date: 2016-08-04 14:55:43 +0200 (Thu, 04 Aug 2016) New Revision: 4025 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/R/fmCov.R pkg/FactorAnalytics/R/fmSdDecomp.R pkg/FactorAnalytics/man/fmCov.Rd pkg/FactorAnalytics/man/fmSdDecomp.Rd Log: Option for user specified factor cov in fmCov and fmSdDecomp Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2016-08-04 12:36:18 UTC (rev 4024) +++ pkg/FactorAnalytics/DESCRIPTION 2016-08-04 12:55:43 UTC (rev 4025) @@ -1,7 +1,7 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.34 +Version: 2.0.35 Date: 2016-08-04 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Modified: pkg/FactorAnalytics/R/fmCov.R =================================================================== --- pkg/FactorAnalytics/R/fmCov.R 2016-08-04 12:36:18 UTC (rev 4024) +++ pkg/FactorAnalytics/R/fmCov.R 2016-08-04 12:55:43 UTC (rev 4025) @@ -19,13 +19,19 @@ #' where, B is the \code{N x K} matrix of factor betas and \code{D} is a #' diagonal matrix with \code{sig(i)^2} along the diagonal. #' -#' The method for computing covariance can be specified via the \dots +#' For the time series factor model, the user can specify a factor covariance +#' matrix; otherwise the default is to use the sample covariance from factor +#' returns. The method for computing covariance can be specified via the \dots #' argument. Note that the default of \code{use="pairwise.complete.obs"} for #' handling NAs restricts the method to "pearson". #' +#' For the statistical and fundamental factor model, the factor model +#' covariances already computed via the model fitting functions are simply +#' recalled by this method for user convenience. +#' #' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}. -#' @param factor.cov factor covariance matrix (optional); defaults to the -#' sample covariance matrix. +#' @param factor.cov optional user specified factor covariance matrix with +#' named columns; defaults to the sample covariance matrix. #' @param use method for computing covariances in the presence of missing #' values; one of "everything", "all.obs", "complete.obs", "na.or.complete", or #' "pairwise.complete.obs". Default is "pairwise.complete.obs". @@ -92,7 +98,10 @@ if (missing(factor.cov)) { factor.cov = cov(factor, use=use, ...) } else { - identical(dim(factor.cov), as.integer(c(ncol(factor), ncol(factor)))) + if (!identical(dim(factor.cov), as.integer(c(ncol(factor), ncol(factor))))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitTsfm object") + } } # residual covariance matrix D @@ -115,7 +124,7 @@ #' @method fmCov sfm #' @export -fmCov.sfm <- function(object, use="pairwise.complete.obs", ...) { +fmCov.sfm <- function(object, ...) { # already computed via fitSfm function return(object$Omega) @@ -125,7 +134,7 @@ #' @method fmCov ffm #' @export -fmCov.ffm <- function(object, use="pairwise.complete.obs", ...) { +fmCov.ffm <- function(object, ...) { # already computed via fitFfm function return(object$return.cov) Modified: pkg/FactorAnalytics/R/fmSdDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmSdDecomp.R 2016-08-04 12:36:18 UTC (rev 4024) +++ pkg/FactorAnalytics/R/fmSdDecomp.R 2016-08-04 12:55:43 UTC (rev 4025) @@ -19,11 +19,11 @@ #' \code{mSd = cov(F.star)beta.star / Sd.fm} #' #' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}. -#' @param use an optional character string giving a method for computing -#' covariances in the presence of missing values. This must be (an -#' abbreviation of) one of the strings "everything", "all.obs", -#' "complete.obs", "na.or.complete", or "pairwise.complete.obs". Default is -#' "pairwise.complete.obs". +#' @param factor.cov optional user specified factor covariance matrix with +#' named columns; defaults to the sample covariance matrix. +#' @param use method for computing covariances in the presence of missing +#' values; one of "everything", "all.obs", "complete.obs", "na.or.complete", or +#' "pairwise.complete.obs". Default is "pairwise.complete.obs". #' @param ... optional arguments passed to \code{\link[stats]{cov}}. #' #' @return A list containing @@ -33,7 +33,7 @@ #' \item{pcSd}{N x (K+1) matrix of percentage component contributions to SD.} #' Where, \code{K} is the number of factors and N is the number of assets. #' -#' @author Eric Zivot, Sangeetha Srinivasan and Yi-An Chen +#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan #' #' @references #' Hallerback (2003). Decomposing Portfolio Value-at-Risk: A General Analysis. @@ -95,7 +95,8 @@ #' @method fmSdDecomp tsfm #' @export -fmSdDecomp.tsfm <- function(object, use="pairwise.complete.obs", ...) { +fmSdDecomp.tsfm <- function(object, factor.cov, + use="pairwise.complete.obs", ...) { # get beta.star: N x (K+1) beta <- object$beta @@ -105,7 +106,14 @@ # get cov(F): K x K factor <- as.matrix(object$data[, object$factor.names]) - factor.cov = cov(factor, use=use, ...) + if (missing(factor.cov)) { + factor.cov = cov(factor, use=use, ...) + } else { + if (!identical(dim(factor.cov), as.integer(c(ncol(factor), ncol(factor))))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitTsfm object") + } + } # get cov(F.star): (K+1) x (K+1) K <- ncol(object$beta) @@ -132,7 +140,8 @@ #' @method fmSdDecomp sfm #' @export -fmSdDecomp.sfm <- function(object, use="pairwise.complete.obs", ...) { +fmSdDecomp.sfm <- function(object, factor.cov, + use="pairwise.complete.obs", ...) { # get beta.star: N x (K+1) beta <- object$loadings @@ -142,7 +151,14 @@ # get cov(F): K x K factor <- as.matrix(object$factors) - factor.cov = cov(factor, use=use, ...) + if (missing(factor.cov)) { + factor.cov = cov(factor, use=use, ...) + } else { + if (!identical(dim(factor.cov), as.integer(c(ncol(factor), ncol(factor))))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitSfm object") + } + } # get cov(F.star): (K+1) x (K+1) K <- object$k @@ -169,7 +185,7 @@ #' @method fmSdDecomp ffm #' @export -fmSdDecomp.ffm <- function(object, ...) { +fmSdDecomp.ffm <- function(object, factor.cov, ...) { # get beta.star: N x (K+1) beta <- object$beta @@ -177,7 +193,15 @@ colnames(beta.star)[dim(beta.star)[2]] <- "residual" # get cov(F): K x K - factor.cov = object$factor.cov + if (missing(factor.cov)) { + factor.cov = object$factor.cov + } else { + if (!identical(dim(factor.cov), dim(object$factor.cov))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors (including dummies) in the + fitFfm object") + } + } # get cov(F.star): (K+1) x (K+1) K <- ncol(object$beta) Modified: pkg/FactorAnalytics/man/fmCov.Rd =================================================================== --- pkg/FactorAnalytics/man/fmCov.Rd 2016-08-04 12:36:18 UTC (rev 4024) +++ pkg/FactorAnalytics/man/fmCov.Rd 2016-08-04 12:55:43 UTC (rev 4025) @@ -11,17 +11,17 @@ \method{fmCov}{tsfm}(object, factor.cov, use = "pairwise.complete.obs", ...) -\method{fmCov}{sfm}(object, use = "pairwise.complete.obs", ...) +\method{fmCov}{sfm}(object, ...) -\method{fmCov}{ffm}(object, use = "pairwise.complete.obs", ...) +\method{fmCov}{ffm}(object, ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} \item{...}{optional arguments passed to \code{\link[stats]{cov}}.} -\item{factor.cov}{factor covariance matrix (optional); defaults to the -sample covariance matrix.} +\item{factor.cov}{optional user specified factor covariance matrix with +named columns; defaults to the sample covariance matrix.} \item{use}{method for computing covariances in the presence of missing values; one of "everything", "all.obs", "complete.obs", "na.or.complete", or @@ -52,9 +52,15 @@ where, B is the \code{N x K} matrix of factor betas and \code{D} is a diagonal matrix with \code{sig(i)^2} along the diagonal. -The method for computing covariance can be specified via the \dots +For the time series factor model, the user can specify a factor covariance +matrix; otherwise the default is to use the sample covariance from factor +returns. The method for computing covariance can be specified via the \dots argument. Note that the default of \code{use="pairwise.complete.obs"} for handling NAs restricts the method to "pearson". + +For the statistical and fundamental factor model, the factor model +covariances already computed via the model fitting functions are simply +recalled by this method for user convenience. } \examples{ # Time Series Factor model Modified: pkg/FactorAnalytics/man/fmSdDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmSdDecomp.Rd 2016-08-04 12:36:18 UTC (rev 4024) +++ pkg/FactorAnalytics/man/fmSdDecomp.Rd 2016-08-04 12:55:43 UTC (rev 4025) @@ -9,22 +9,25 @@ \usage{ fmSdDecomp(object, ...) -\method{fmSdDecomp}{tsfm}(object, use = "pairwise.complete.obs", ...) +\method{fmSdDecomp}{tsfm}(object, factor.cov, use = "pairwise.complete.obs", + ...) -\method{fmSdDecomp}{sfm}(object, use = "pairwise.complete.obs", ...) +\method{fmSdDecomp}{sfm}(object, factor.cov, use = "pairwise.complete.obs", + ...) -\method{fmSdDecomp}{ffm}(object, ...) +\method{fmSdDecomp}{ffm}(object, factor.cov, ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} \item{...}{optional arguments passed to \code{\link[stats]{cov}}.} -\item{use}{an optional character string giving a method for computing -covariances in the presence of missing values. This must be (an -abbreviation of) one of the strings "everything", "all.obs", -"complete.obs", "na.or.complete", or "pairwise.complete.obs". Default is -"pairwise.complete.obs".} +\item{factor.cov}{optional user specified factor covariance matrix with +named columns; defaults to the sample covariance matrix.} + +\item{use}{method for computing covariances in the presence of missing +values; one of "everything", "all.obs", "complete.obs", "na.or.complete", or +"pairwise.complete.obs". Default is "pairwise.complete.obs".} } \value{ A list containing @@ -72,7 +75,7 @@ } \author{ -Eric Zivot, Sangeetha Srinivasan and Yi-An Chen +Eric Zivot, Yi-An Chen and Sangeetha Srinivasan } \references{ Hallerback (2003). Decomposing Portfolio Value-at-Risk: A General Analysis. From noreply at r-forge.r-project.org Fri Aug 5 17:21:42 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Aug 2016 17:21:42 +0200 (CEST) Subject: [Returnanalytics-commits] r4026 - in pkg/FactorAnalytics: . R man Message-ID: <20160805152142.EDA5D180149@r-forge.r-project.org> Author: pragnya Date: 2016-08-05 17:21:42 +0200 (Fri, 05 Aug 2016) New Revision: 4026 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/R/fmVaRDecomp.R pkg/FactorAnalytics/man/fmVaRDecomp.Rd Log: Updated fmVaRDecomp to include normal VaR, user defined factor cov Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2016-08-04 12:55:43 UTC (rev 4025) +++ pkg/FactorAnalytics/DESCRIPTION 2016-08-05 15:21:42 UTC (rev 4026) @@ -1,7 +1,7 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.35 +Version: 2.0.36 Date: 2016-08-04 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Modified: pkg/FactorAnalytics/R/fmVaRDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmVaRDecomp.R 2016-08-04 12:55:43 UTC (rev 4025) +++ pkg/FactorAnalytics/R/fmVaRDecomp.R 2016-08-05 15:21:42 UTC (rev 4026) @@ -18,15 +18,18 @@ #' being equal to \code{VaR.fm}. This is approximated as described in #' Epperlein & Smillie (2006); a triangular smoothing kernel is used here. #' +#' Refer to Eric Zivot's slides (referenced) for formulas pertaining to the +#' calculation of Normal VaR (adapted from a portfolio context to factor models) +#' #' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}. +#' @param factor.cov optional user specified factor covariance matrix with +#' named columns; defaults to the sample covariance matrix. #' @param p confidence level for calculation. Default is 0.95. #' @param type one of "np" (non-parametric) or "normal" for calculating VaR. #' Default is "np". -#' @param use an optional character string giving a method for computing factor -#' covariances in the presence of missing values. This must be (an -#' abbreviation of) one of the strings "everything", "all.obs", -#' "complete.obs", "na.or.complete", or "pairwise.complete.obs". Default is -#' "pairwise.complete.obs". +#' @param use method for computing covariances in the presence of missing +#' values; one of "everything", "all.obs", "complete.obs", "na.or.complete", or +#' "pairwise.complete.obs". Default is "pairwise.complete.obs". #' @param ... other optional arguments passed to \code{\link[stats]{quantile}}. #' #' @return A list containing @@ -39,9 +42,12 @@ #' \item{pcVaR}{N x (K+1) matrix of percentage component contributions to VaR.} #' Where, \code{K} is the number of factors and N is the number of assets. #' -#' @author Eric Zivot, Sangeetha Srinivasan and Yi-An Chen +#' @author Eric Zivot, Yi-An Chen and Sangeetha Srinivasan #' #' @references +#' Eric Zivot's slides from CFRM 546: Estimating risk measures: Portfolio of +#' Assets, April 28, 2015. +#' #' Hallerback (2003). Decomposing Portfolio Value-at-Risk: A General Analysis. #' The Journal of Risk, 5(2), 1-18. #' @@ -63,7 +69,7 @@ #' data(managers) #' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]), #' factor.names=colnames(managers[,(7:8)]), data=managers) -#' +#' #' VaR.decomp <- fmVaRDecomp(fit.macro) #' # get the component contributions #' VaR.decomp$cVaR @@ -71,9 +77,19 @@ #' # Statistical Factor Model #' data(StockReturns) #' sfm.pca.fit <- fitSfm(r.M, k=2) -#' VaR.decomp <- fmVaRDecomp(sfm.pca.fit) +#' +#' VaR.decomp <- fmVaRDecomp(sfm.pca.fit, type="normal") #' VaR.decomp$cVaR #' +#' # Fundamental Factor Model +#' data(Stock.df) +#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") +#' fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", +#' date.var="DATE", exposure.vars=exposure.vars) +#' +#' VaR.decomp <- fmVaRDecomp(fit, type="normal") +#' VaR.decomp$cVaR +#' #' @export fmVaRDecomp <- function(object, ...){ @@ -88,12 +104,11 @@ #' @method fmVaRDecomp tsfm #' @export -fmVaRDecomp.tsfm <- function(object, p=0.95, type=c("np","normal"), +fmVaRDecomp.tsfm <- function(object, factor.cov, p=0.95, type=c("np","normal"), use="pairwise.complete.obs", ...) { # set default for type type = type[1] - if (!(type %in% c("np","normal"))) { stop("Invalid args: type must be 'np' or 'normal' ") } @@ -111,7 +126,14 @@ if (type=="normal") { # get cov(F): K x K - factor.cov = cov(as.matrix(factors.xts), use=use, ...) + if (missing(factor.cov)) { + factor.cov = cov(as.matrix(factors.xts), use=use, ...) + } else { + if (!identical(dim(factor.cov), as.integer(c(ncol(factor), ncol(factor))))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitTsfm object") + } + } # get cov(F.star): (K+1) x (K+1) K <- ncol(object$beta) @@ -122,6 +144,7 @@ # factor expected returns MU <- c(colMeans(factors.xts, na.rm=TRUE), 0) + names(MU) <- colnames(beta.star) # SIGMA*Beta to compute normal mVaR SIGB <- beta.star %*% factor.star.cov @@ -138,38 +161,33 @@ cVaR <- matrix(NA, N, K+1) pcVaR <- matrix(NA, N, K+1) rownames(mVaR)=rownames(cVaR)=rownames(pcVaR)=object$asset.names - colnames(mVaR)=colnames(cVaR)=colnames(pcVaR)=c(object$factor.names, - "residuals") + colnames(mVaR)=colnames(cVaR)=colnames(pcVaR)=c(object$factor.names, "residuals") + for (i in object$asset.names) { # return data for asset i R.xts <- object$data[,i] # get VaR for asset i if (type=="np") { VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) - } + } else if (type=="normal") { - VaR.fm[i] <- mean(R.xts, na.rm=TRUE) + sd(R.xts, na.rm=TRUE)*qnorm(1-p) + VaR.fm[i] <- beta.star[i,] %*% MU + + sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) } # index of VaR exceedances idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) # number of VaR exceedances n.exceed[i] <- length(idx.exceed[[i]]) - # # plot exceedances for asset i - # plot(R.xts, type="b", main="Asset Returns and 5% VaR Violations", - # ylab="Returns") - # abline(h=0) - # abline(h=VaR.fm[i], lwd=2, col="red") - # points(R.xts[idx.exceed[[i]]], type="p", pch=16, col="red") - - # get F.star data object - factor.star <- merge(factors.xts, resid.xts[,i]) - colnames(factor.star)[dim(factor.star)[2]] <- "residual" - if (type=="np") { + # get F.star data object + factor.star <- merge(factors.xts, resid.xts[,i]) + colnames(factor.star)[dim(factor.star)[2]] <- "residual" + # epsilon is apprx. using Silverman's rule of thumb (bandwidth selection) # the constant 2.575 corresponds to a triangular kernel eps <- 2.575*sd(R.xts, na.rm =TRUE) * (nrow(R.xts)^(-1/5)) + # compute marginal VaR as expected value of factor returns, such that the # asset return was incident in the triangular kernel region peaked at the # VaR value and bandwidth = epsilon. @@ -201,12 +219,11 @@ #' @method fmVaRDecomp sfm #' @export -fmVaRDecomp.sfm <- function(object, p=0.95, type=c("np","normal"), +fmVaRDecomp.sfm <- function(object, factor.cov, p=0.95, type=c("np","normal"), use="pairwise.complete.obs", ...) { # set default for type type = type[1] - if (!(type %in% c("np","normal"))) { stop("Invalid args: type must be 'np' or 'normal' ") } @@ -224,10 +241,17 @@ if (type=="normal") { # get cov(F): K x K - factor.cov = cov(as.matrix(factors.xts), use=use, ...) + if (missing(factor.cov)) { + factor.cov = cov(as.matrix(factors.xts), use=use, ...) + } else { + if (!identical(dim(factor.cov), as.integer(c(object$k, object$k)))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitSfm object") + } + } # get cov(F.star): (K+1) x (K+1) - K <- ncol(object$beta) + K <- object$k factor.star.cov <- diag(K+1) factor.star.cov[1:K, 1:K] <- factor.cov colnames(factor.star.cov) <- c(colnames(factor.cov),"residuals") @@ -258,24 +282,26 @@ R.xts <- object$data[,i] # get VaR for asset i if (type=="np") { - VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) - } + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE) + } else if (type=="normal") { - VaR.fm[i] <- mean(R.xts, na.rm=TRUE) + sd(R.xts, na.rm=TRUE)*qnorm(1-p) + VaR.fm[i] <- beta.star[i,] %*% MU + + sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) } # index of VaR exceedances idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) # number of VaR exceedances n.exceed[i] <- length(idx.exceed[[i]]) - # get F.star data object - factor.star <- merge(factors.xts, resid.xts[,i]) - colnames(factor.star)[dim(factor.star)[2]] <- "residual" - if (type=="np") { + # get F.star data object + factor.star <- merge(factors.xts, resid.xts[,i]) + colnames(factor.star)[dim(factor.star)[2]] <- "residual" + # epsilon is apprx. using Silverman's rule of thumb (bandwidth selection) # the constant 2.575 corresponds to a triangular kernel eps <- 2.575*sd(R.xts, na.rm =TRUE) * (nrow(R.xts)^(-1/5)) + # compute marginal VaR as expected value of factor returns, such that the # asset return was incident in the triangular kernel region peaked at the # VaR value and bandwidth = epsilon. @@ -283,7 +309,7 @@ k.weight[k.weight<0] <- 0 mVaR[i,] <- colMeans(factor.star*k.weight, na.rm =TRUE) } - else if (type=="normal") { + else if (type=="normal") { mVaR[i,] <- t(MU) + SIGB[i,] * qnorm(1-p)/sd(R.xts, na.rm=TRUE) } @@ -307,11 +333,11 @@ #' @method fmVaRDecomp ffm #' @export -fmVaRDecomp.ffm <- function(object, p=0.95, type=c("np","normal"), ...) { +fmVaRDecomp.ffm <- function(object, factor.cov, p=0.95, type=c("np","normal"), + use="pairwise.complete.obs", ...) { # set default for type type = type[1] - if (!(type %in% c("np","normal"))) { stop("Invalid args: type must be 'np' or 'normal' ") } @@ -329,7 +355,14 @@ if (type=="normal") { # get cov(F): K x K - factor.cov = object$factor.cov + if (missing(factor.cov)) { + factor.cov <- object$factor.cov + } else { + if (!identical(dim(factor.cov), dim(object$factor.cov))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitSfm object") + } + } # get cov(F.star): (K+1) x (K+1) K <- ncol(object$beta) @@ -356,31 +389,35 @@ cVaR <- matrix(NA, N, K+1) pcVaR <- matrix(NA, N, K+1) rownames(mVaR)=rownames(cVaR)=rownames(pcVaR)=object$asset.names - colnames(mVaR)=colnames(cVaR)=colnames(pcVaR)=c(object$factor.names, - "residuals") + colnames(mVaR)=colnames(cVaR)=colnames(pcVaR)=c(object$factor.names, "residuals") + for (i in object$asset.names) { # return data for asset i - R.xts <- object$data[,i] + subrows <- which(object$data[[object$asset.var]]==i) + R.xts <- as.xts(object$data[subrows,object$ret.var], + as.Date(object$data[subrows,object$date.var])) # get VaR for asset i if (type=="np") { VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) - } + } else if (type=="normal") { - VaR.fm[i] <- mean(R.xts, na.rm=TRUE) + sd(R.xts, na.rm=TRUE)*qnorm(1-p) + VaR.fm[i] <- beta.star[i,] %*% MU + + sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) } # index of VaR exceedances idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) # number of VaR exceedances n.exceed[i] <- length(idx.exceed[[i]]) - # get F.star data object - factor.star <- merge(factors.xts, resid.xts[,i]) - colnames(factor.star)[dim(factor.star)[2]] <- "residual" - if (type=="np") { + # get F.star data object + factor.star <- merge(factors.xts, resid.xts[,i]) + colnames(factor.star)[dim(factor.star)[2]] <- "residual" + # epsilon is apprx. using Silverman's rule of thumb (bandwidth selection) # the constant 2.575 corresponds to a triangular kernel eps <- 2.575*sd(R.xts, na.rm =TRUE) * (nrow(R.xts)^(-1/5)) + # compute marginal VaR as expected value of factor returns, such that the # asset return was incident in the triangular kernel region peaked at the # VaR value and bandwidth = epsilon. @@ -406,4 +443,4 @@ mVaR=mVaR, cVaR=cVaR, pcVaR=pcVaR) return(fm.VaR.decomp) -} +} \ No newline at end of file Modified: pkg/FactorAnalytics/man/fmVaRDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2016-08-04 12:55:43 UTC (rev 4025) +++ pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2016-08-05 15:21:42 UTC (rev 4026) @@ -9,29 +9,31 @@ \usage{ fmVaRDecomp(object, ...) -\method{fmVaRDecomp}{tsfm}(object, p = 0.95, type = c("np", "normal"), - use = "pairwise.complete.obs", ...) +\method{fmVaRDecomp}{tsfm}(object, factor.cov, p = 0.95, type = c("np", + "normal"), use = "pairwise.complete.obs", ...) -\method{fmVaRDecomp}{sfm}(object, p = 0.95, type = c("np", "normal"), - use = "pairwise.complete.obs", ...) +\method{fmVaRDecomp}{sfm}(object, factor.cov, p = 0.95, type = c("np", + "normal"), use = "pairwise.complete.obs", ...) -\method{fmVaRDecomp}{ffm}(object, p = 0.95, type = c("np", "normal"), ...) +\method{fmVaRDecomp}{ffm}(object, factor.cov, p = 0.95, type = c("np", + "normal"), use = "pairwise.complete.obs", ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} \item{...}{other optional arguments passed to \code{\link[stats]{quantile}}.} +\item{factor.cov}{optional user specified factor covariance matrix with +named columns; defaults to the sample covariance matrix.} + \item{p}{confidence level for calculation. Default is 0.95.} \item{type}{one of "np" (non-parametric) or "normal" for calculating VaR. Default is "np".} -\item{use}{an optional character string giving a method for computing factor -covariances in the presence of missing values. This must be (an -abbreviation of) one of the strings "everything", "all.obs", -"complete.obs", "na.or.complete", or "pairwise.complete.obs". Default is -"pairwise.complete.obs".} +\item{use}{method for computing covariances in the presence of missing +values; one of "everything", "all.obs", "complete.obs", "na.or.complete", or +"pairwise.complete.obs". Default is "pairwise.complete.obs".} } \value{ A list containing @@ -62,14 +64,17 @@ contributions to \code{VaR} respectively. The marginal contribution to VaR is defined as the expectation of \code{F.star}, conditional on the loss being equal to \code{VaR.fm}. This is approximated as described in -Epperlein & Smillie (2006); a triangular smoothing kernel is used here. +Epperlein & Smillie (2006); a triangular smoothing kernel is used here. + +Refer to Eric Zivot's slides (referenced) for formulas pertaining to the +calculation of Normal VaR (adapted from a portfolio context to factor models) } \examples{ # Time Series Factor Model data(managers) fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]), factor.names=colnames(managers[,(7:8)]), data=managers) - + VaR.decomp <- fmVaRDecomp(fit.macro) # get the component contributions VaR.decomp$cVaR @@ -77,14 +82,27 @@ # Statistical Factor Model data(StockReturns) sfm.pca.fit <- fitSfm(r.M, k=2) -VaR.decomp <- fmVaRDecomp(sfm.pca.fit) + +VaR.decomp <- fmVaRDecomp(sfm.pca.fit, type="normal") VaR.decomp$cVaR +# Fundamental Factor Model +data(Stock.df) +exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") +fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", + date.var="DATE", exposure.vars=exposure.vars) + +VaR.decomp <- fmVaRDecomp(fit, type="normal") +VaR.decomp$cVaR + } \author{ -Eric Zivot, Sangeetha Srinivasan and Yi-An Chen +Eric Zivot, Yi-An Chen and Sangeetha Srinivasan } \references{ +Eric Zivot's slides from CFRM 546: Estimating risk measures: Portfolio of +Assets, April 28, 2015. + Hallerback (2003). Decomposing Portfolio Value-at-Risk: A General Analysis. The Journal of Risk, 5(2), 1-18. From noreply at r-forge.r-project.org Sat Aug 6 20:03:53 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 6 Aug 2016 20:03:53 +0200 (CEST) Subject: [Returnanalytics-commits] r4027 - in pkg/FactorAnalytics: . R man Message-ID: <20160806180353.4DA4E187F54@r-forge.r-project.org> Author: pragnya Date: 2016-08-06 20:03:52 +0200 (Sat, 06 Aug 2016) New Revision: 4027 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/R/fmEsDecomp.R pkg/FactorAnalytics/R/fmVaRDecomp.R pkg/FactorAnalytics/man/fmEsDecomp.Rd pkg/FactorAnalytics/man/fmVaRDecomp.Rd Log: Add option, examples for user specified factor cov and Normal VaR and ES Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2016-08-05 15:21:42 UTC (rev 4026) +++ pkg/FactorAnalytics/DESCRIPTION 2016-08-06 18:03:52 UTC (rev 4027) @@ -1,8 +1,8 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.36 -Date: 2016-08-04 +Version: 2.0.37 +Date: 2016-08-06 Author: Eric Zivot, Sangeetha Srinivasan and Yi-An Chen Maintainer: Sangeetha Srinivasan Description: Linear factor model fitting for asset returns (three major types- Modified: pkg/FactorAnalytics/R/fmEsDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmEsDecomp.R 2016-08-05 15:21:42 UTC (rev 4026) +++ pkg/FactorAnalytics/R/fmEsDecomp.R 2016-08-06 18:03:52 UTC (rev 4027) @@ -19,22 +19,22 @@ #' being less than or equal to \code{VaR.fm}. This is estimated as a sample #' average of the observations in that data window. #' +#' Refer to Eric Zivot's slides (referenced) for formulas pertaining to the +#' calculation of Normal ES (adapted from a portfolio context to factor models). +#' #' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}. +#' @param factor.cov optional user specified factor covariance matrix with +#' named columns; defaults to the sample covariance matrix. #' @param p confidence level for calculation. Default is 0.95. #' @param type one of "np" (non-parametric) or "normal" for calculating VaR. #' Default is "np". -#' @param use an optional character string giving a method for computing factor -#' covariances in the presence of missing values. This must be (an -#' abbreviation of) one of the strings "everything", "all.obs", -#' "complete.obs", "na.or.complete", or "pairwise.complete.obs". Default is -#' "pairwise.complete.obs". +#' @param use method for computing covariances in the presence of missing +#' values; one of "everything", "all.obs", "complete.obs", "na.or.complete", or +#' "pairwise.complete.obs". Default is "pairwise.complete.obs". #' @param ... other optional arguments passed to \code{\link[stats]{quantile}}. #' #' @return A list containing #' \item{ES.fm}{length-N vector of factor model ES of N-asset returns.} -#' \item{n.exceed}{length-N vector of number of observations beyond VaR for -#' each asset.} -#' \item{idx.exceed}{list of numeric vector of index values of exceedances.} #' \item{mES}{N x (K+1) matrix of marginal contributions to VaR.} #' \item{cES}{N x (K+1) matrix of component contributions to VaR.} #' \item{pcES}{N x (K+1) matrix of percentage component contributions to VaR.} @@ -43,6 +43,9 @@ #' @author Eric Zviot, Sangeetha Srinivasan and Yi-An Chen #' #' @references +#' Eric Zivot's slides from CFRM 546: Estimating risk measures: Portfolio of +#' Assets, April 28, 2015. +#' #' Epperlein, E., & Smillie, A. (2006). Portfolio risk analysis Cracking VAR #' with kernels. RISK-LONDON-RISK MAGAZINE LIMITED-, 19(8), 70. #' @@ -63,7 +66,7 @@ #' \code{\link{fmVaRDecomp}} for factor model VaR decomposition. #' #' @examples -#' # Time Series Factor Model +#' #' # Time Series Factor Model #' data(managers) #' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]), #' factor.names=colnames(managers[,(7:8)]), data=managers) @@ -74,9 +77,17 @@ #' # Statistical Factor Model #' data(StockReturns) #' sfm.pca.fit <- fitSfm(r.M, k=2) -#' ES.decomp <- fmEsDecomp(sfm.pca.fit) +#' ES.decomp <- fmEsDecomp(sfm.pca.fit, type="normal") #' ES.decomp$cES #' +#' # Fundamental Factor Model +#' data(Stock.df) +#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") +#' fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", +#' date.var="DATE", exposure.vars=exposure.vars) +#' ES.decomp <- fmEsDecomp(fit, type="normal") +#' head(ES.decomp$cES) +#' #' @export fmEsDecomp <- function(object, ...){ @@ -91,9 +102,8 @@ #' @method fmEsDecomp tsfm #' @export -fmEsDecomp.tsfm <- function(object, p=0.95, type=c("np","normal"), +fmEsDecomp.tsfm <- function(object, factor.cov, p=0.95, type=c("np","normal"), use="pairwise.complete.obs", ...) { - # set default for type type = type[1] @@ -112,14 +122,36 @@ resid.xts <- as.xts(t(t(residuals(object))/object$resid.sd)) time(resid.xts) <- as.Date(time(resid.xts)) + if (type=="normal") { + # get cov(F): K x K + if (missing(factor.cov)) { + factor.cov = cov(as.matrix(factors.xts), use=use, ...) + } else { + if (!identical(dim(factor.cov), as.integer(c(ncol(factor), ncol(factor))))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitTsfm object") + } + } + # get cov(F.star): (K+1) x (K+1) + K <- ncol(object$beta) + factor.star.cov <- diag(K+1) + factor.star.cov[1:K, 1:K] <- factor.cov + colnames(factor.star.cov) <- c(colnames(factor.cov),"residuals") + rownames(factor.star.cov) <- c(colnames(factor.cov),"residuals") + # factor expected returns + MU <- c(colMeans(factors.xts, na.rm=TRUE), 0) + names(MU) <- colnames(beta.star) + # SIGMA*Beta to compute normal mES + SIGB <- beta.star %*% factor.star.cov + } + # initialize lists and matrices N <- length(object$asset.names) K <- length(object$factor.names) VaR.fm <- rep(NA, N) ES.fm <- rep(NA, N) idx.exceed <- list() - n.exceed <- rep(NA, N) - names(VaR.fm) = names(ES.fm) = names(n.exceed) = object$asset.names + names(VaR.fm) = names(ES.fm) = object$asset.names mES <- matrix(NA, N, K+1) cES <- matrix(NA, N, K+1) pcES <- matrix(NA, N, K+1) @@ -129,29 +161,31 @@ for (i in object$asset.names) { # return data for asset i R.xts <- object$data[,i] - # get VaR for asset i - if (type=="np") { + + if (type=="np") { + # get VaR for asset i VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) - } else { - VaR.fm[i] <- mean(R.xts, na.rm=TRUE) + sd(R.xts, na.rm=TRUE)*qnorm(1-p) + # index of VaR exceedances + idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) + # compute ES as expected value of asset return, such that the given asset + # return is less than or equal to its value-at-risk (VaR) + ES.fm[i] <- mean(R.xts[idx.exceed[[i]]], na.rm =TRUE) + # get F.star data object + factor.star <- merge(factors.xts, resid.xts[,i]) + colnames(factor.star)[dim(factor.star)[2]] <- "residual" + # compute marginal ES as expected value of factor returns, when the asset's + # return is less than or equal to its value-at-risk (VaR) + mES[i,] <- colMeans(factor.star[idx.exceed[[i]],], na.rm =TRUE) + + } else if (type=="normal") { + # extract vector of factor model loadings for asset i + beta.i <- beta.star[i,,drop=F] + # compute ES + ES.fm[i] <- beta.star[i,] %*% MU + sqrt(beta.i %*% factor.star.cov %*% t(beta.i))*dnorm(qnorm(1-p))/(1-p) + # compute marginal ES + mES[i,] <- t(MU) + SIGB[i,]/sd(R.xts, na.rm=TRUE) * dnorm(qnorm(1-p))/(1-p) } - # index of VaR exceedances - idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) - # number of VaR exceedances - n.exceed[i] <- length(idx.exceed[[i]]) - # compute ES as expected value of asset return, such that the given asset - # return is less than or equal to its value-at-risk (VaR) - ES.fm[i] <- mean(R.xts[idx.exceed[[i]]], na.rm =TRUE) - - # get F.star data object - factor.star <- merge(factors.xts, resid.xts[,i]) - colnames(factor.star)[dim(factor.star)[2]] <- "residual" - - # compute marginal ES as expected value of factor returns, when the asset's - # return is less than or equal to its value-at-risk (VaR) - mES[i,] <- colMeans(factor.star[idx.exceed[[i]],], na.rm =TRUE) - # correction factor to ensure that sum(cES) = asset ES cf <- as.numeric( ES.fm[i] / sum(mES[i,]*beta.star[i,], na.rm=TRUE) ) @@ -162,8 +196,7 @@ pcES[i,] <- 100* cES[i,] / ES.fm[i] } - fm.ES.decomp <- list(ES.fm=ES.fm, n.exceed=n.exceed, idx.exceed=idx.exceed, - mES=mES, cES=cES, pcES=pcES) + fm.ES.decomp <- list(ES.fm=ES.fm, mES=mES, cES=cES, pcES=pcES) return(fm.ES.decomp) } @@ -172,9 +205,8 @@ #' @method fmEsDecomp sfm #' @export -fmEsDecomp.sfm <- function(object, p=0.95, type=c("np","normal"), +fmEsDecomp.sfm <- function(object, factor.cov, p=0.95, type=c("np","normal"), use="pairwise.complete.obs", ...) { - # set default for type type = type[1] @@ -193,46 +225,171 @@ resid.xts <- as.xts(t(t(residuals(object))/object$resid.sd)) time(resid.xts) <- as.Date(time(resid.xts)) + if (type=="normal") { + # get cov(F): K x K + if (missing(factor.cov)) { + factor.cov = cov(as.matrix(factors.xts), use=use, ...) + } else { + if (!identical(dim(factor.cov), as.integer(c(object$k, object$k)))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitSfm object") + } + } + # get cov(F.star): (K+1) x (K+1) + K <- object$k + factor.star.cov <- diag(K+1) + factor.star.cov[1:K, 1:K] <- factor.cov + colnames(factor.star.cov) <- c(colnames(factor.cov),"residuals") + rownames(factor.star.cov) <- c(colnames(factor.cov),"residuals") + # factor expected returns + MU <- c(colMeans(factors.xts, na.rm=TRUE), 0) + # SIGMA*Beta to compute normal mVaR + SIGB <- beta.star %*% factor.star.cov + } + # initialize lists and matrices N <- length(object$asset.names) K <- object$k VaR.fm <- rep(NA, N) ES.fm <- rep(NA, N) idx.exceed <- list() - n.exceed <- rep(NA, N) - names(VaR.fm) = names(ES.fm) = names(n.exceed) = object$asset.names + names(VaR.fm) = names(ES.fm) = object$asset.names mES <- matrix(NA, N, K+1) cES <- matrix(NA, N, K+1) pcES <- matrix(NA, N, K+1) rownames(mES)=rownames(cES)=rownames(pcES)=object$asset.names - colnames(mES)=colnames(cES)=colnames(pcES)=c(paste("F",1:K,sep="."), - "residuals") + colnames(mES)=colnames(cES)=colnames(pcES)=c(paste("F",1:K,sep="."),"residuals") for (i in object$asset.names) { # return data for asset i R.xts <- object$data[,i] - # get VaR for asset i + if (type=="np") { + # get VaR for asset i VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) - } else { - VaR.fm[i] <- mean(R.xts, na.rm=TRUE) + sd(R.xts, na.rm=TRUE)*qnorm(1-p) + # index of VaR exceedances + idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) + # compute ES as expected value of asset return, such that the given asset + # return is less than or equal to its value-at-risk (VaR) + ES.fm[i] <- mean(R.xts[idx.exceed[[i]]], na.rm =TRUE) + # get F.star data object + factor.star <- merge(factors.xts, resid.xts[,i]) + colnames(factor.star)[dim(factor.star)[2]] <- "residual" + # compute marginal ES as expected value of factor returns, when the asset's + # return is less than or equal to its value-at-risk (VaR) + mES[i,] <- colMeans(factor.star[idx.exceed[[i]],], na.rm =TRUE) + + } else if (type=="normal") { + # extract vector of factor model loadings for asset i + beta.i <- beta.star[i,,drop=F] + # compute ES + ES.fm[i] <- beta.star[i,] %*% MU + sqrt(beta.i %*% factor.star.cov %*% t(beta.i))*dnorm(qnorm(1-p))/(1-p) + # compute marginal ES + mES[i,] <- t(MU) + SIGB[i,]/sd(R.xts, na.rm=TRUE) * dnorm(qnorm(1-p))/(1-p) } - # index of VaR exceedances - idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) - # number of VaR exceedances - n.exceed[i] <- length(idx.exceed[[i]]) - # compute ES as expected value of asset return, such that the given asset - # return is less than or equal to its value-at-risk (VaR) - ES.fm[i] <- mean(R.xts[idx.exceed[[i]]], na.rm =TRUE) + # correction factor to ensure that sum(cES) = asset ES + cf <- as.numeric( ES.fm[i] / sum(mES[i,]*beta.star[i,], na.rm=TRUE) ) - # get F.star data object - factor.star <- merge(factors.xts, resid.xts[,i]) - colnames(factor.star)[dim(factor.star)[2]] <- "residual" + # compute marginal, component and percentage contributions to ES + # each of these have dimensions: N x (K+1) + mES[i,] <- cf * mES[i,] + cES[i,] <- mES[i,] * beta.star[i,] + pcES[i,] <- 100* cES[i,] / ES.fm[i] + } + + fm.ES.decomp <- list(ES.fm=ES.fm, mES=mES, cES=cES, pcES=pcES) + + return(fm.ES.decomp) +} + +#' @rdname fmEsDecomp +#' @method fmEsDecomp ffm +#' @export + +fmEsDecomp.ffm <- function(object, factor.cov, p=0.95, type=c("np","normal"), + use="pairwise.complete.obs", ...) { + # set default for type + type = type[1] + if (!(type %in% c("np","normal"))) { + stop("Invalid args: type must be 'np' or 'normal' ") + } + + # get beta.star + beta <- object$beta + beta[is.na(beta)] <- 0 + beta.star <- as.matrix(cbind(beta, sqrt(object$resid.var))) + colnames(beta.star)[dim(beta.star)[2]] <- "residual" + + # factor returns and residuals data + factors.xts <- object$factor.returns + resid.xts <- as.xts(t(t(residuals(object))/sqrt(object$resid.var))) + time(resid.xts) <- as.Date(time(resid.xts)) + + if (type=="normal") { + # get cov(F): K x K + if (missing(factor.cov)) { + factor.cov <- object$factor.cov + } else { + if (!identical(dim(factor.cov), dim(object$factor.cov))) { + stop("Dimensions of user specified factor covariance matrix are not + compatible with the number of factors in the fitSfm object") + } + } + # get cov(F.star): (K+1) x (K+1) + K <- ncol(object$beta) + factor.star.cov <- diag(K+1) + factor.star.cov[1:K, 1:K] <- factor.cov + colnames(factor.star.cov) <- c(colnames(factor.cov),"residuals") + rownames(factor.star.cov) <- c(colnames(factor.cov),"residuals") + # factor expected returns + MU <- c(colMeans(factors.xts, na.rm=TRUE), 0) + # SIGMA*Beta to compute normal mVaR + SIGB <- beta.star %*% factor.star.cov + } + + # initialize lists and matrices + N <- length(object$asset.names) + K <- length(object$factor.names) + VaR.fm <- rep(NA, N) + ES.fm <- rep(NA, N) + idx.exceed <- list() + names(VaR.fm) = names(ES.fm) = object$asset.names + mES <- matrix(NA, N, K+1) + cES <- matrix(NA, N, K+1) + pcES <- matrix(NA, N, K+1) + rownames(mES)=rownames(cES)=rownames(pcES)=object$asset.names + colnames(mES)=colnames(cES)=colnames(pcES)=c(object$factor.names, "residuals") + + for (i in object$asset.names) { + # return data for asset i + subrows <- which(object$data[[object$asset.var]]==i) + R.xts <- as.xts(object$data[subrows,object$ret.var], + as.Date(object$data[subrows,object$date.var])) - # compute marginal ES as expected value of factor returns, when the asset's - # return is less than or equal to its value-at-risk (VaR) - mES[i,] <- colMeans(factor.star[idx.exceed[[i]],], na.rm =TRUE) + if (type=="np") { + # get VaR for asset i + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) + # index of VaR exceedances + idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) + # compute ES as expected value of asset return, such that the given asset + # return is less than or equal to its value-at-risk (VaR) + ES.fm[i] <- mean(R.xts[idx.exceed[[i]]], na.rm =TRUE) + # get F.star data object + factor.star <- merge(factors.xts, resid.xts[,i]) + colnames(factor.star)[dim(factor.star)[2]] <- "residual" + # compute marginal ES as expected value of factor returns, when the asset's + # return is less than or equal to its value-at-risk (VaR) + mES[i,] <- colMeans(factor.star[idx.exceed[[i]],], na.rm =TRUE) + + } else if (type=="normal") { + # extract vector of factor model loadings for asset i + beta.i <- beta.star[i,,drop=F] + # compute ES + ES.fm[i] <- beta.star[i,] %*% MU + sqrt(beta.i %*% factor.star.cov %*% t(beta.i))*dnorm(qnorm(1-p))/(1-p) + # compute marginal ES + mES[i,] <- t(MU) + SIGB[i,]/sd(R.xts, na.rm=TRUE) * dnorm(qnorm(1-p))/(1-p) + } # correction factor to ensure that sum(cES) = asset ES cf <- as.numeric( ES.fm[i] / sum(mES[i,]*beta.star[i,], na.rm=TRUE) ) @@ -244,8 +401,7 @@ pcES[i,] <- 100* cES[i,] / ES.fm[i] } - fm.ES.decomp <- list(ES.fm=ES.fm, n.exceed=n.exceed, idx.exceed=idx.exceed, - mES=mES, cES=cES, pcES=pcES) + fm.ES.decomp <- list(ES.fm=ES.fm, mES=mES, cES=cES, pcES=pcES) return(fm.ES.decomp) } Modified: pkg/FactorAnalytics/R/fmVaRDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmVaRDecomp.R 2016-08-05 15:21:42 UTC (rev 4026) +++ pkg/FactorAnalytics/R/fmVaRDecomp.R 2016-08-06 18:03:52 UTC (rev 4027) @@ -69,7 +69,6 @@ #' data(managers) #' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]), #' factor.names=colnames(managers[,(7:8)]), data=managers) -#' #' VaR.decomp <- fmVaRDecomp(fit.macro) #' # get the component contributions #' VaR.decomp$cVaR @@ -77,7 +76,6 @@ #' # Statistical Factor Model #' data(StockReturns) #' sfm.pca.fit <- fitSfm(r.M, k=2) -#' #' VaR.decomp <- fmVaRDecomp(sfm.pca.fit, type="normal") #' VaR.decomp$cVaR #' @@ -86,7 +84,6 @@ #' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") #' fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", #' date.var="DATE", exposure.vars=exposure.vars) -#' #' VaR.decomp <- fmVaRDecomp(fit, type="normal") #' VaR.decomp$cVaR #' @@ -106,7 +103,6 @@ fmVaRDecomp.tsfm <- function(object, factor.cov, p=0.95, type=c("np","normal"), use="pairwise.complete.obs", ...) { - # set default for type type = type[1] if (!(type %in% c("np","normal"))) { @@ -134,18 +130,15 @@ compatible with the number of factors in the fitTsfm object") } } - # get cov(F.star): (K+1) x (K+1) K <- ncol(object$beta) factor.star.cov <- diag(K+1) factor.star.cov[1:K, 1:K] <- factor.cov colnames(factor.star.cov) <- c(colnames(factor.cov),"residuals") rownames(factor.star.cov) <- c(colnames(factor.cov),"residuals") - # factor expected returns MU <- c(colMeans(factors.xts, na.rm=TRUE), 0) names(MU) <- colnames(beta.star) - # SIGMA*Beta to compute normal mVaR SIGB <- beta.star %*% factor.star.cov } @@ -166,20 +159,11 @@ for (i in object$asset.names) { # return data for asset i R.xts <- object$data[,i] - # get VaR for asset i - if (type=="np") { - VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) - } - else if (type=="normal") { - VaR.fm[i] <- beta.star[i,] %*% MU + - sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) - } - # index of VaR exceedances - idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) - # number of VaR exceedances - n.exceed[i] <- length(idx.exceed[[i]]) if (type=="np") { + # get VaR for asset i + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) + # get F.star data object factor.star <- merge(factors.xts, resid.xts[,i]) colnames(factor.star)[dim(factor.star)[2]] <- "residual" @@ -194,11 +178,21 @@ k.weight <- as.vector(1 - abs(R.xts - VaR.fm[i]) / eps) k.weight[k.weight<0] <- 0 mVaR[i,] <- colMeans(factor.star*k.weight, na.rm =TRUE) - } - else if (type=="normal") { + + } else if (type=="normal") { + # get VaR for asset i + VaR.fm[i] <- beta.star[i,] %*% MU + + sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) + + # compute marginal VaR mVaR[i,] <- t(MU) + SIGB[i,] * qnorm(1-p)/sd(R.xts, na.rm=TRUE) } + # index of VaR exceedances + idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) + # number of VaR exceedances + n.exceed[i] <- length(idx.exceed[[i]]) + # correction factor to ensure that sum(cVaR) = asset VaR cf <- as.numeric( VaR.fm[i] / sum(mVaR[i,]*beta.star[i,], na.rm=TRUE) ) @@ -221,7 +215,6 @@ fmVaRDecomp.sfm <- function(object, factor.cov, p=0.95, type=c("np","normal"), use="pairwise.complete.obs", ...) { - # set default for type type = type[1] if (!(type %in% c("np","normal"))) { @@ -249,17 +242,14 @@ compatible with the number of factors in the fitSfm object") } } - # get cov(F.star): (K+1) x (K+1) K <- object$k factor.star.cov <- diag(K+1) factor.star.cov[1:K, 1:K] <- factor.cov colnames(factor.star.cov) <- c(colnames(factor.cov),"residuals") rownames(factor.star.cov) <- c(colnames(factor.cov),"residuals") - # factor expected returns MU <- c(colMeans(factors.xts, na.rm=TRUE), 0) - # SIGMA*Beta to compute normal mVaR SIGB <- beta.star %*% factor.star.cov } @@ -280,20 +270,11 @@ for (i in object$asset.names) { # return data for asset i R.xts <- object$data[,i] - # get VaR for asset i - if (type=="np") { - VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE) - } - else if (type=="normal") { - VaR.fm[i] <- beta.star[i,] %*% MU + - sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) - } - # index of VaR exceedances - idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) - # number of VaR exceedances - n.exceed[i] <- length(idx.exceed[[i]]) if (type=="np") { + # get VaR for asset i + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) + # get F.star data object factor.star <- merge(factors.xts, resid.xts[,i]) colnames(factor.star)[dim(factor.star)[2]] <- "residual" @@ -308,11 +289,21 @@ k.weight <- as.vector(1 - abs(R.xts - VaR.fm[i]) / eps) k.weight[k.weight<0] <- 0 mVaR[i,] <- colMeans(factor.star*k.weight, na.rm =TRUE) - } - else if (type=="normal") { + + } else if (type=="normal") { + # get VaR for asset i + VaR.fm[i] <- beta.star[i,] %*% MU + + sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) + + # compute marginal VaR mVaR[i,] <- t(MU) + SIGB[i,] * qnorm(1-p)/sd(R.xts, na.rm=TRUE) } + # index of VaR exceedances + idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) + # number of VaR exceedances + n.exceed[i] <- length(idx.exceed[[i]]) + # correction factor to ensure that sum(cVaR) = asset VaR cf <- as.numeric( VaR.fm[i] / sum(mVaR[i,]*beta.star[i,], na.rm=TRUE) ) @@ -335,7 +326,6 @@ fmVaRDecomp.ffm <- function(object, factor.cov, p=0.95, type=c("np","normal"), use="pairwise.complete.obs", ...) { - # set default for type type = type[1] if (!(type %in% c("np","normal"))) { @@ -363,17 +353,14 @@ compatible with the number of factors in the fitSfm object") } } - # get cov(F.star): (K+1) x (K+1) K <- ncol(object$beta) factor.star.cov <- diag(K+1) factor.star.cov[1:K, 1:K] <- factor.cov colnames(factor.star.cov) <- c(colnames(factor.cov),"residuals") rownames(factor.star.cov) <- c(colnames(factor.cov),"residuals") - # factor expected returns MU <- c(colMeans(factors.xts, na.rm=TRUE), 0) - # SIGMA*Beta to compute normal mVaR SIGB <- beta.star %*% factor.star.cov } @@ -396,20 +383,11 @@ subrows <- which(object$data[[object$asset.var]]==i) R.xts <- as.xts(object$data[subrows,object$ret.var], as.Date(object$data[subrows,object$date.var])) - # get VaR for asset i - if (type=="np") { - VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) - } - else if (type=="normal") { - VaR.fm[i] <- beta.star[i,] %*% MU + - sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) - } - # index of VaR exceedances - idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) - # number of VaR exceedances - n.exceed[i] <- length(idx.exceed[[i]]) if (type=="np") { + # get VaR for asset i + VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) + # get F.star data object factor.star <- merge(factors.xts, resid.xts[,i]) colnames(factor.star)[dim(factor.star)[2]] <- "residual" @@ -424,11 +402,21 @@ k.weight <- as.vector(1 - abs(R.xts - VaR.fm[i]) / eps) k.weight[k.weight<0] <- 0 mVaR[i,] <- colMeans(factor.star*k.weight, na.rm =TRUE) - } - else if (type=="normal") { + + } else if (type=="normal") { + # get VaR for asset i + VaR.fm[i] <- beta.star[i,] %*% MU + + sqrt(beta.star[i,,drop=F] %*% factor.star.cov %*% t(beta.star[i,,drop=F]))*qnorm(1-p) + + # compute marginal VaR mVaR[i,] <- t(MU) + SIGB[i,] * qnorm(1-p)/sd(R.xts, na.rm=TRUE) } + # index of VaR exceedances + idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) + # number of VaR exceedances + n.exceed[i] <- length(idx.exceed[[i]]) + # correction factor to ensure that sum(cVaR) = asset VaR cf <- as.numeric( VaR.fm[i] / sum(mVaR[i,]*beta.star[i,], na.rm=TRUE) ) Modified: pkg/FactorAnalytics/man/fmEsDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmEsDecomp.Rd 2016-08-05 15:21:42 UTC (rev 4026) +++ pkg/FactorAnalytics/man/fmEsDecomp.Rd 2016-08-06 18:03:52 UTC (rev 4027) @@ -2,32 +2,42 @@ % Please edit documentation in R/fmEsDecomp.R \name{fmEsDecomp} \alias{fmEsDecomp} +\alias{fmEsDecomp.ffm} \alias{fmEsDecomp.sfm} \alias{fmEsDecomp.tsfm} \title{Decompose ES into individual factor contributions} \usage{ fmEsDecomp(object, ...) -\method{fmEsDecomp}{tsfm}(object, p = 0.95, type = c("np", "normal"), ...) +\method{fmEsDecomp}{tsfm}(object, factor.cov, p = 0.95, type = c("np", + "normal"), use = "pairwise.complete.obs", ...) -\method{fmEsDecomp}{sfm}(object, p = 0.95, type = c("np", "normal"), ...) +\method{fmEsDecomp}{sfm}(object, factor.cov, p = 0.95, type = c("np", + "normal"), use = "pairwise.complete.obs", ...) + +\method{fmEsDecomp}{ffm}(object, factor.cov, p = 0.95, type = c("np", + "normal"), use = "pairwise.complete.obs", ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} \item{...}{other optional arguments passed to \code{\link[stats]{quantile}}.} +\item{factor.cov}{optional user specified factor covariance matrix with +named columns; defaults to the sample covariance matrix.} + \item{p}{confidence level for calculation. Default is 0.95.} \item{type}{one of "np" (non-parametric) or "normal" for calculating VaR. Default is "np".} + +\item{use}{method for computing covariances in the presence of missing +values; one of "everything", "all.obs", "complete.obs", "na.or.complete", or +"pairwise.complete.obs". Default is "pairwise.complete.obs".} } \value{ A list containing \item{ES.fm}{length-N vector of factor model ES of N-asset returns.} -\item{n.exceed}{length-N vector of number of observations beyond VaR for -each asset.} -\item{idx.exceed}{list of numeric vector of index values of exceedances.} \item{mES}{N x (K+1) matrix of marginal contributions to VaR.} \item{cES}{N x (K+1) matrix of component contributions to VaR.} \item{pcES}{N x (K+1) matrix of percentage component contributions to VaR.} @@ -52,10 +62,13 @@ contributions to \code{ES} respectively. The marginal contribution to ES is defined as the expected value of \code{F.star}, conditional on the loss being less than or equal to \code{VaR.fm}. This is estimated as a sample -average of the observations in that data window. +average of the observations in that data window. + +Refer to Eric Zivot's slides (referenced) for formulas pertaining to the +calculation of Normal ES (adapted from a portfolio context to factor models). } \examples{ -# Time Series Factor Model +#' # Time Series Factor Model data(managers) fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]), factor.names=colnames(managers[,(7:8)]), data=managers) @@ -66,14 +79,25 @@ # Statistical Factor Model data(StockReturns) sfm.pca.fit <- fitSfm(r.M, k=2) -ES.decomp <- fmEsDecomp(sfm.pca.fit) +ES.decomp <- fmEsDecomp(sfm.pca.fit, type="normal") ES.decomp$cES +# Fundamental Factor Model +data(Stock.df) +exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") +fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", + date.var="DATE", exposure.vars=exposure.vars) +ES.decomp <- fmEsDecomp(fit, type="normal") +head(ES.decomp$cES) + } \author{ Eric Zviot, Sangeetha Srinivasan and Yi-An Chen } \references{ +Eric Zivot's slides from CFRM 546: Estimating risk measures: Portfolio of +Assets, April 28, 2015. + Epperlein, E., & Smillie, A. (2006). Portfolio risk analysis Cracking VAR with kernels. RISK-LONDON-RISK MAGAZINE LIMITED-, 19(8), 70. Modified: pkg/FactorAnalytics/man/fmVaRDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2016-08-05 15:21:42 UTC (rev 4026) +++ pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2016-08-06 18:03:52 UTC (rev 4027) @@ -74,7 +74,6 @@ data(managers) fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]), factor.names=colnames(managers[,(7:8)]), data=managers) - VaR.decomp <- fmVaRDecomp(fit.macro) # get the component contributions VaR.decomp$cVaR @@ -82,7 +81,6 @@ # Statistical Factor Model data(StockReturns) sfm.pca.fit <- fitSfm(r.M, k=2) - VaR.decomp <- fmVaRDecomp(sfm.pca.fit, type="normal") VaR.decomp$cVaR @@ -91,7 +89,6 @@ exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP") fit <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", date.var="DATE", exposure.vars=exposure.vars) - VaR.decomp <- fmVaRDecomp(fit, type="normal") VaR.decomp$cVaR