From noreply at r-forge.r-project.org Sun Mar 6 16:16:42 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 6 Mar 2016 16:16:42 +0100 (CET) Subject: [Returnanalytics-commits] r4007 - pkg/PerformanceAnalytics/R Message-ID: <20160306151642.ADABF18811F@r-forge.r-project.org> Author: bodanker Date: 2016-03-06 16:16:41 +0100 (Sun, 06 Mar 2016) New Revision: 4007 Modified: pkg/PerformanceAnalytics/R/PortfolioRisk.R Log: Standardized skewness/kurtosis = zero if sd = zero Add functions to encapsulate standardized skewness and kurtosis calculations. Implement Kris' suggestion to return zero if the standard deviation is zero. Thanks to cloudcello for the report. Modified: pkg/PerformanceAnalytics/R/PortfolioRisk.R =================================================================== --- pkg/PerformanceAnalytics/R/PortfolioRisk.R 2016-01-17 03:13:53 UTC (rev 4006) +++ pkg/PerformanceAnalytics/R/PortfolioRisk.R 2016-03-06 15:16:41 UTC (rev 4007) @@ -26,8 +26,8 @@ m2 = centeredmoment(R,2) m3 = centeredmoment(R,3) m4 = centeredmoment(R,4) - skew = m3 / m2^(3/2); - exkur = m4 / m2^(2) - 3; + skew = .skewEst(m3, m2) + exkur = .kurtEst(m4, m2) JB = ( length(R)/6 )*( skew^2 + (1/4)*(exkur^2) ) out = 1-pchisq(JB,df=2) } @@ -92,10 +92,8 @@ m2 = centeredmoment(r,2) m3 = centeredmoment(r,3) m4 = centeredmoment(r,4) - skew = m3 / m2^(3/2); - exkurt = m4 / m2^(2) - 3; - # skew=skewness(r) - # exkurt=kurtosis(r) + skew = .skewEst(m3, m2) + exkurt = .kurtEst(m4, m2) h = z + (1/6)*(z^2 -1)*skew + (1/24)*(z^3 - 3*z)*exkurt - (1/36)*(2*z^3 - 5*z)*skew^2 @@ -128,8 +126,8 @@ m2 = centeredmoment(r,2) m3 = centeredmoment(r,3) m4 = centeredmoment(r,4) - skew = m3 / m2^(3/2); - exkurt = m4 / m2^(2) - 3; + skew = .skewEst(m3, m2) + exkurt = .kurtEst(m4, m2) h = z + (1/6)*(z^2 -1)*skew if(c==2){ h = h + (1/24)*(z^3 - 3*z)*exkurt - (1/36)*(2*z^3 - 5*z)*skew^2}; @@ -165,8 +163,8 @@ m2 = centeredmoment(r,2) m3 = centeredmoment(r,3) m4 = centeredmoment(r,4) - skew = m3 / m2^(3/2); - exkurt = m4 / m2^(2) - 3; + skew = .skewEst(m3, m2) + exkurt = .kurtEst(m4, m2) h = z + (1/6)*(z^2 -1)*skew if(c==2){ h = h + (1/24)*(z^3 - 3*z)*exkurt - (1/36)*(2*z^3 - 5*z)*skew^2}; @@ -341,8 +339,8 @@ pm4 = portm4(w,M4) dpm4 = as.vector( derportm4(w,M4) ) - skew = pm3 / pm2^(3/2); - exkurt = pm4 / pm2^(2) - 3; + skew = .skewEst(pm3, pm2) + exkurt = .kurtEst(pm4, pm2) derskew = ( 2*(pm2^(3/2))*dpm3 - 3*pm3*sqrt(pm2)*dpm2 )/(2*pm2^3) derexkurt = ( (pm2)*dpm4 - 2*pm4*dpm2 )/(pm2^3) @@ -426,8 +424,8 @@ pm4 = portm4(w,M4) dpm4 = as.vector( derportm4(w,M4) ) - skew = pm3 / pm2^(3/2); - exkurt = pm4 / pm2^(2) - 3; + skew = .skewEst(pm3, pm2) + exkurt = .kurtEst(pm4, pm2) derskew = ( 2*(pm2^(3/2))*dpm3 - 3*pm3*sqrt(pm2)*dpm2 )/(2*pm2^3) derexkurt = ( (pm2)*dpm4 - 2*pm4*dpm2 )/(pm2^3) @@ -480,8 +478,8 @@ pm4 = portm4(w,M4) dpm4 = as.vector( derportm4(w,M4) ) - skew = pm3 / pm2^(3/2); - exkurt = pm4 / pm2^(2) - 3; + skew = .skewEst(pm3, pm2) + exkurt = .kurtEst(pm4, pm2) derskew = ( 2*(pm2^(3/2))*dpm3 - 3*pm3*sqrt(pm2)*dpm2 )/(2*pm2^3) derexkurt = ( (pm2)*dpm4 - 2*pm4*dpm2 )/(pm2^3) @@ -618,6 +616,22 @@ return(ret) } +.skewEst <- function(m3, m2) { + if (isTRUE(all.equal(m2, 0.0))) { + return(0.0) + } else { + return(m3 / m2^(3/2)) + } +} + +.kurtEst <- function(m4, m2) { + if (isTRUE(all.equal(m2, 0.0))) { + return(0.0) + } else { + return(m4 / m2^2 - 3) + } +} + ############################################################################### # R (http://r-project.org/) Econometrics for Performance and Risk Analysis # @@ -628,4 +642,4 @@ # # $Id$ # -############################################################################### \ No newline at end of file +############################################################################### From noreply at r-forge.r-project.org Sun Mar 6 17:01:29 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 6 Mar 2016 17:01:29 +0100 (CET) Subject: [Returnanalytics-commits] r4008 - pkg/PerformanceAnalytics/R Message-ID: <20160306160129.7EF7E187396@r-forge.r-project.org> Author: bodanker Date: 2016-03-06 17:01:29 +0100 (Sun, 06 Mar 2016) New Revision: 4008 Modified: pkg/PerformanceAnalytics/R/ES.R Log: Add reasonableness check for non-finite ES If any of the various ES functions returns NaN, +/-Inf, NA, etc, the first reasonableness check fails because you cannot compare non-finite values in an if-statement. Thanks to cloudcello for the report. Modified: pkg/PerformanceAnalytics/R/ES.R =================================================================== --- pkg/PerformanceAnalytics/R/ES.R 2016-03-06 15:16:41 UTC (rev 4007) +++ pkg/PerformanceAnalytics/R/ES.R 2016-03-06 16:01:29 UTC (rev 4008) @@ -194,6 +194,11 @@ columns<-ncol(rES) for(column in 1:columns) { tmp=rES[,column] + if (!is.finite(tmp)) { + message(c("ES calculation returned non-finite result for column: ", column, " : ", rES[, column])) + # set ES to NA, since risk is unreasonable + rES[, column] <- NA + } else if (eval(0 > tmp)) { #eval added previously to get around Sweave bitching message(c("ES calculation produces unreliable result (inverse risk) for column: ",column," : ",rES[,column])) # set ES to NA, since inverse risk is unreasonable @@ -243,4 +248,4 @@ # # $Id$ # -############################################################################### \ No newline at end of file +############################################################################### From noreply at r-forge.r-project.org Sun Mar 6 17:31:26 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 6 Mar 2016 17:31:26 +0100 (CET) Subject: [Returnanalytics-commits] r4009 - pkg/PerformanceAnalytics/R Message-ID: <20160306163126.2C8F01876A5@r-forge.r-project.org> Author: bodanker Date: 2016-03-06 17:31:25 +0100 (Sun, 06 Mar 2016) New Revision: 4009 Modified: pkg/PerformanceAnalytics/R/Return.clean.R Log: Catch error and return original series if sd=0 We can't invert 'sigma' if the standard deviation is zero (all returns are the same), so trap the potential error and return the original return series. Thanks to cloudcello for the report. Modified: pkg/PerformanceAnalytics/R/Return.clean.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.clean.R 2016-03-06 16:01:29 UTC (rev 4008) +++ pkg/PerformanceAnalytics/R/Return.clean.R 2016-03-06 16:31:25 UTC (rev 4009) @@ -214,11 +214,17 @@ MCD = robustbase::covMcd(as.matrix(R),alpha=1-alpha) mu = as.matrix(MCD$raw.center) #no reweighting sigma = MCD$raw.cov - invSigma = solve(sigma); + invSigma = try(solve(sigma), silent=TRUE) vd2t = c(); cleaneddata = R outlierdate = c() + if(inherits(invSigma, "try-error")) { + warning("Returning original data; unable to clean data due to error:\n", + attr(invSigma, "condition")[["message"]]) + return(list(cleaneddata,outlierdate)) + } + # 1. Sort the data in function of their extremeness # Extremeness is proxied by the robustly estimated squared Mahalanbobis distance From noreply at r-forge.r-project.org Thu Mar 17 11:23:46 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Mar 2016 11:23:46 +0100 (CET) Subject: [Returnanalytics-commits] r4010 - pkg/FactorAnalytics/R Message-ID: <20160317102346.15979184B54@r-forge.r-project.org> Author: pragnya Date: 2016-03-17 11:23:45 +0100 (Thu, 17 Mar 2016) New Revision: 4010 Modified: pkg/FactorAnalytics/R/plot.tsfm.r Log: Display fitted normal and skew-t parameters in the plots for residual distribution Modified: pkg/FactorAnalytics/R/plot.tsfm.r =================================================================== --- pkg/FactorAnalytics/R/plot.tsfm.r 2016-03-06 16:31:25 UTC (rev 4009) +++ pkg/FactorAnalytics/R/plot.tsfm.r 2016-03-17 10:23:45 UTC (rev 4010) @@ -175,8 +175,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 { @@ -278,6 +279,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)) @@ -287,6 +290,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") @@ -295,6 +300,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, @@ -430,9 +437,6 @@ plot( barchart(as.matrix(x$alpha)[a.sub,], main="Factor model Alpha (Intercept)", xlab="", col=colorset[1], ...) ) - # barplot(coef(x)[a.sub,1], main="Factor model Alpha (Intercept)", - # names.arg=rownames(coef(x))[a.sub], col=colorset[1], las=2, ...) - # abline(h=0, lwd=1, lty=1, col=1) }, "2L" = { ## Factor model coefficients: Betas @@ -444,14 +448,6 @@ barchart(Y~X|Z, main="Factor model Betas \n", xlab="", as.table=TRUE, origin=0, col=colorset[1], scales=list(relation="free"), ...) ) - # par(mfrow=c(ceiling(length(f.sub)/2),2)) - # for (i in f.sub) { - # main=paste(colnames(coef(x))[i+1], "factor Betas") - # barplot(coef(x)[,i+1], main=main, names.arg=rownames(coef(x)), - # col=colorset[1], las=2, ...) - # abline(h=0, lwd=1, lty=1, col=1) - # } - # par(mfrow=c(1,1)) }, "3L" = { ## Actual and fitted asset returns From noreply at r-forge.r-project.org Thu Mar 17 12:10:27 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Mar 2016 12:10:27 +0100 (CET) Subject: [Returnanalytics-commits] r4011 - in pkg/FactorAnalytics: . R man Message-ID: <20160317111027.A1F95180503@r-forge.r-project.org> Author: pragnya Date: 2016-03-17 12:10:27 +0100 (Thu, 17 Mar 2016) New Revision: 4011 Added: pkg/FactorAnalytics/R/summary.ffm.R pkg/FactorAnalytics/man/summary.ffm.Rd Modified: pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fitFfm.R pkg/FactorAnalytics/R/fitTsfm.R pkg/FactorAnalytics/R/fmCov.R pkg/FactorAnalytics/R/print.ffm.R pkg/FactorAnalytics/man/fitFfm.Rd pkg/FactorAnalytics/man/fmCov.Rd pkg/FactorAnalytics/man/print.ffm.Rd Log: Adding summary and fmCov methods for fitFfm Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2016-03-17 10:23:45 UTC (rev 4010) +++ pkg/FactorAnalytics/NAMESPACE 2016-03-17 11:10:27 UTC (rev 4011) @@ -6,6 +6,7 @@ S3method(fitted,ffm) S3method(fitted,sfm) S3method(fitted,tsfm) +S3method(fmCov,ffm) S3method(fmCov,sfm) S3method(fmCov,tsfm) S3method(fmEsDecomp,sfm) @@ -24,6 +25,7 @@ S3method(print,ffm) S3method(print,pafm) S3method(print,sfm) +S3method(print,summary.ffm) S3method(print,summary.sfm) S3method(print,summary.tsfm) S3method(print,summary.tsfmUpDn) @@ -32,6 +34,7 @@ S3method(residuals,ffm) S3method(residuals,sfm) S3method(residuals,tsfm) +S3method(summary,ffm) S3method(summary,pafm) S3method(summary,sfm) S3method(summary,tsfm) Modified: pkg/FactorAnalytics/R/fitFfm.R =================================================================== --- pkg/FactorAnalytics/R/fitFfm.R 2016-03-17 10:23:45 UTC (rev 4010) +++ pkg/FactorAnalytics/R/fitFfm.R 2016-03-17 11:10:27 UTC (rev 4011) @@ -77,9 +77,10 @@ #' #' An object of class \code{"ffm"} is a list containing the following #' components: -#' \item{factor.fit}{list of fitted objects for each time period. Each object -#' is of class \code{lm} if \code{fit.method="LS" or "WLS"}, or, class -#' \code{lmRob} if \code{fit.method="Rob" or "W-Rob"}.} +#' \item{factor.fit}{list of fitted objects that estimate factor returns in each +#' time period. Each fitted object is of class \code{lm} if +#' \code{fit.method="LS" or "WLS"}, or, class \code{lmRob} if +#' \code{fit.method="Rob" or "W-Rob"}.} #' \item{beta}{N x K matrix of factor exposures for the last time period.} #' \item{factor.returns}{xts object of K-factor returns (including intercept).} #' \item{residuals}{xts object of residuals for N-assets.} Modified: pkg/FactorAnalytics/R/fitTsfm.R =================================================================== --- pkg/FactorAnalytics/R/fitTsfm.R 2016-03-17 10:23:45 UTC (rev 4010) +++ pkg/FactorAnalytics/R/fitTsfm.R 2016-03-17 11:10:27 UTC (rev 4011) @@ -351,7 +351,7 @@ # choose best subset of factors depending on specified subset size fm.subsets <- do.call("regsubsets", c(list(fm.formula,data=quote(reg.xts)), - regsubsets.args)) + regsubsets.args)) sum.sub <- summary(fm.subsets) # choose best model of a given subset size nvmax=nvmin (or) @@ -457,7 +457,7 @@ # makePaddedDataFrame <- function(l) { DF <- do.call("rbind", lapply(lapply(l, unlist), "[", - unique(unlist(c(sapply(l,names)))))) + unique(unlist(c(sapply(l,names)))))) DF <- as.data.frame(DF) names(DF) <- unique(unlist(c(sapply(l,names)))) # as.matrix(DF) # if matrix output needed Modified: pkg/FactorAnalytics/R/fmCov.R =================================================================== --- pkg/FactorAnalytics/R/fmCov.R 2016-03-17 10:23:45 UTC (rev 4010) +++ pkg/FactorAnalytics/R/fmCov.R 2016-03-17 11:10:27 UTC (rev 4011) @@ -56,23 +56,14 @@ #' data(StockReturns) #' sfm.pca.fit <- fitSfm(r.M, k=2) #' fmCov(sfm.pca.fit) -#' -#' \dontrun{ -#' # Fundamental Factor Model -#' data(stock) -#' # there are 447 assets -#' exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") -#' beta.mat <- subset(stock, DATE=="2003-12-31")[, exposure.names] -#' beta.mat1 <- cbind(rep(1, 447), beta.mat1) -#' # FM return covariance -#' fit.fund <- fitFfm(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 <- fmCov(beta.mat1,fit.fund$factor.cov$cov,fit.fund$resid.sd) -#' fit.fund$returns.cov$cov == ret.cov.fundm -#' } #' +#' # Fundamental factor Model +#' data(Stock.df) +#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.SECTOR") +#' fit2 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", +#' date.var="DATE", exposure.vars=exposure.vars) +#' fmCov(fit2) +#' #' @rdname fmCov #' @export @@ -130,3 +121,12 @@ return(object$Omega) } +#' @rdname fmCov +#' @method fmCov ffm +#' @export + +fmCov.ffm <- function(object, use="pairwise.complete.obs", ...) { + + # already computed via fitFfm function + return(object$return.cov) +} Modified: pkg/FactorAnalytics/R/print.ffm.R =================================================================== --- pkg/FactorAnalytics/R/print.ffm.R 2016-03-17 10:23:45 UTC (rev 4010) +++ pkg/FactorAnalytics/R/print.ffm.R 2016-03-17 11:10:27 UTC (rev 4011) @@ -5,6 +5,9 @@ #' factor returns, cross-sectional r-squared values and residual variances #' from the fitted object. #' +#' Refer to \code{\link{summary.ffm}} for a more detailed summary of the fit at +#' each time period. +#' #' @param x an object of class \code{ffm} produced by \code{fitFfm}. #' @param digits an integer value, to indicate the required number of #' significant digits. Default is 3. Added: pkg/FactorAnalytics/R/summary.ffm.R =================================================================== --- pkg/FactorAnalytics/R/summary.ffm.R (rev 0) +++ pkg/FactorAnalytics/R/summary.ffm.R 2016-03-17 11:10:27 UTC (rev 4011) @@ -0,0 +1,99 @@ +#' @title Summarizing a fitted fundamental factor model +#' +#' @description \code{summary} method for object of class \code{ffm}. +#' Returned object is of class {summary.ffm}. +#' +#' @details The default \code{summary} method for a fitted \code{lm} object +#' computes the standard errors and t-statistics under the assumption of +#' homoskedasticty. +#' +#' Note: This gives a summary of the fited factor returns at each time period. +#' If \code{T} is large, you might prefer the more succint summary produced by +#' \code{\link{print.ffm}}. +#' +#' @param object an object of class \code{ffm} returned by \code{fitFfm}. +#' @param x an object of class \code{summary.ffm}. +#' @param digits number of significants digits to use when printing. +#' Default is 3. +#' @param labels option to print labels and legend in the summary. Default is +#' \code{TRUE}. When \code{FALSE}, only the coefficient matrx with standard +#' errors is printed. +#' @param ... futher arguments passed to or from other methods. +#' +#' @return Returns an object of class \code{summary.ffm}. +#' The print method for class \code{summary.ffm} outputs the call, +#' coefficients (with standard errors and t-statistics), r-squared and +#' residual volatilty (under the homoskedasticity assumption) for all assets. +#' +#' Object of class \code{summary.ffm} is a list of length N + 2 containing: +#' \item{call}{the function call to \code{fitFfm}} +#' \item{sum.list}{list of summaries of the T fit objects (of class \code{lm} or +#' \code{lmRob}) for each time period in the factor model.} +#' +#' @author Sangeetha Srinivasan & Yi-An Chen. +#' +#' @seealso \code{\link{fitFfm}}, \code{\link[stats]{summary.lm}} +#' +#' @examples +#' data(Stock.df) +#' exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.SECTOR") +#' fit2 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", +#' date.var="DATE", exposure.vars=exposure.vars) +#' +#' # summary of factor returns estimated in each time period +#' summary(fit2) +#' +#' # summary of lm fit for a single period +#' summary(fit2$factor.fit[[1]]) +#' +#' @method summary ffm +#' @export + +summary.ffm <- function(object, ...){ + + # check input object validity + if (!inherits(object, "ffm")) { + stop("Invalid 'ffm' object") + } + + # extract summary.lm objects for each factor + sum.list <- lapply(object$factor.fit, summary) + + # include the call and se.type to fitFfm + sum <- list(call=object$call, sum.list=sum.list) + class(sum) <- "summary.ffm" + return(sum) +} + + +#' @rdname summary.ffm +#' @method print summary.ffm +#' @export + +print.summary.ffm <- function(x, digits=3, labels=TRUE, ...) { + n <- length(x$sum.list) + if (labels==TRUE) { + if(!is.null(cl <- x$call)) { + cat("\nCall:\n") + dput(cl) + } + cat("\nFactor Returns:\n", sep="") + for (i in 1:n) { + options(digits = digits) + table.coef <- (x$sum.list)[[i]]$coefficients + cat("\nTime Period ", i, ": ", names(x$sum.list[i]), "\n\n", sep="") + r2 <- x$sum.list[[i]]$r.squared + sigma <- x$sum.list[[i]]$sigma + printCoefmat(table.coef, digits=digits, ...) + cat("\nR-squared: ", r2,", Residual Volatility: ", sigma,"\n", sep="") + } + } else { + for (i in 1:n) { + options(digits = digits) + table.coef <- (x$sum.list)[[i]]$coefficients + cat(names(x$sum.list[i]), "\n") + printCoefmat(table.coef, digits=digits, signif.legend=FALSE, ...) + cat("\n") + } + } +} Modified: pkg/FactorAnalytics/man/fitFfm.Rd =================================================================== --- pkg/FactorAnalytics/man/fitFfm.Rd 2016-03-17 10:23:45 UTC (rev 4010) +++ pkg/FactorAnalytics/man/fitFfm.Rd 2016-03-17 11:10:27 UTC (rev 4011) @@ -66,9 +66,10 @@ An object of class \code{"ffm"} is a list containing the following components: -\item{factor.fit}{list of fitted objects for each time period. Each object -is of class \code{lm} if \code{fit.method="LS" or "WLS"}, or, class -\code{lmRob} if \code{fit.method="Rob" or "W-Rob"}.} +\item{factor.fit}{list of fitted objects that estimate factor returns in each +time period. Each fitted object is of class \code{lm} if +\code{fit.method="LS" or "WLS"}, or, class \code{lmRob} if +\code{fit.method="Rob" or "W-Rob"}.} \item{beta}{N x K matrix of factor exposures for the last time period.} \item{factor.returns}{xts object of K-factor returns (including intercept).} \item{residuals}{xts object of residuals for N-assets.} Modified: pkg/FactorAnalytics/man/fmCov.Rd =================================================================== --- pkg/FactorAnalytics/man/fmCov.Rd 2016-03-17 10:23:45 UTC (rev 4010) +++ pkg/FactorAnalytics/man/fmCov.Rd 2016-03-17 11:10:27 UTC (rev 4011) @@ -2,6 +2,7 @@ % Please edit documentation in R/fmCov.R \name{fmCov} \alias{fmCov} +\alias{fmCov.ffm} \alias{fmCov.sfm} \alias{fmCov.tsfm} \title{Covariance Matrix for assets' returns from fitted factor model.} @@ -11,6 +12,8 @@ \method{fmCov}{tsfm}(object, factor.cov, use = "pairwise.complete.obs", ...) \method{fmCov}{sfm}(object, use = "pairwise.complete.obs", ...) + +\method{fmCov}{ffm}(object, use = "pairwise.complete.obs", ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} @@ -64,23 +67,14 @@ data(StockReturns) sfm.pca.fit <- fitSfm(r.M, k=2) fmCov(sfm.pca.fit) - -\dontrun{ -# Fundamental Factor Model -data(stock) -# there are 447 assets -exposure.names <- c("BOOK2MARKET", "LOG.MARKETCAP") -beta.mat <- subset(stock, DATE=="2003-12-31")[, exposure.names] -beta.mat1 <- cbind(rep(1, 447), beta.mat1) -# FM return covariance -fit.fund <- fitFfm(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 <- fmCov(beta.mat1,fit.fund$factor.cov$cov,fit.fund$resid.sd) -fit.fund$returns.cov$cov == ret.cov.fundm -} +# Fundamental factor Model +data(Stock.df) +exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.SECTOR") +fit2 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", + date.var="DATE", exposure.vars=exposure.vars) +fmCov(fit2) + } \author{ Eric Zivot, Yi-An Chen and Sangeetha Srinivasan. Modified: pkg/FactorAnalytics/man/print.ffm.Rd =================================================================== --- pkg/FactorAnalytics/man/print.ffm.Rd 2016-03-17 10:23:45 UTC (rev 4010) +++ pkg/FactorAnalytics/man/print.ffm.Rd 2016-03-17 11:10:27 UTC (rev 4011) @@ -18,7 +18,10 @@ S3 \code{print} method for object of class \code{ffm}. Prints the call, factor model dimension and summary statistics for the estimated factor returns, cross-sectional r-squared values and residual variances -from the fitted object. +from the fitted object. + +Refer to \code{\link{summary.ffm}} for a more detailed summary of the fit at +each time period. } \examples{ data(Stock.df) Added: pkg/FactorAnalytics/man/summary.ffm.Rd =================================================================== --- pkg/FactorAnalytics/man/summary.ffm.Rd (rev 0) +++ pkg/FactorAnalytics/man/summary.ffm.Rd 2016-03-17 11:10:27 UTC (rev 4011) @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.ffm.R +\name{summary.ffm} +\alias{print.summary.ffm} +\alias{summary.ffm} +\title{Summarizing a fitted fundamental factor model} +\usage{ +\method{summary}{ffm}(object, ...) + +\method{print}{summary.ffm}(x, digits = 3, labels = TRUE, ...) +} +\arguments{ +\item{object}{an object of class \code{ffm} returned by \code{fitFfm}.} + +\item{...}{futher arguments passed to or from other methods.} + +\item{x}{an object of class \code{summary.ffm}.} + +\item{digits}{number of significants digits to use when printing. +Default is 3.} + +\item{labels}{option to print labels and legend in the summary. Default is +\code{TRUE}. When \code{FALSE}, only the coefficient matrx with standard +errors is printed.} +} +\value{ +Returns an object of class \code{summary.ffm}. +The print method for class \code{summary.ffm} outputs the call, +coefficients (with standard errors and t-statistics), r-squared and +residual volatilty (under the homoskedasticity assumption) for all assets. + +Object of class \code{summary.ffm} is a list of length N + 2 containing: +\item{call}{the function call to \code{fitFfm}} +\item{sum.list}{list of summaries of the T fit objects (of class \code{lm} or +\code{lmRob}) for each time period in the factor model.} +} +\description{ +\code{summary} method for object of class \code{ffm}. +Returned object is of class {summary.ffm}. +} +\details{ +The default \code{summary} method for a fitted \code{lm} object +computes the standard errors and t-statistics under the assumption of +homoskedasticty. + +Note: This gives a summary of the fited factor returns at each time period. +If \code{T} is large, you might prefer the more succint summary produced by +\code{\link{print.ffm}}. +} +\examples{ +data(Stock.df) +exposure.vars <- c("BOOK2MARKET", "LOG.MARKETCAP", "GICS.SECTOR") +fit2 <- fitFfm(data=stock, asset.var="TICKER", ret.var="RETURN", + date.var="DATE", exposure.vars=exposure.vars) + +# summary of factor returns estimated in each time period +summary(fit2) + +# summary of lm fit for a single period +summary(fit2$factor.fit[[1]]) + +} +\author{ +Sangeetha Srinivasan & Yi-An Chen. +} +\seealso{ +\code{\link{fitFfm}}, \code{\link[stats]{summary.lm}} +} + From noreply at r-forge.r-project.org Thu Mar 17 13:15:03 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Mar 2016 13:15:03 +0100 (CET) Subject: [Returnanalytics-commits] r4012 - in pkg/FactorAnalytics: . R man Message-ID: <20160317121503.9A1F3186505@r-forge.r-project.org> Author: pragnya Date: 2016-03-17 13:15:03 +0100 (Thu, 17 Mar 2016) New Revision: 4012 Modified: pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fmSdDecomp.R pkg/FactorAnalytics/man/fmSdDecomp.Rd Log: Add fmSdDecomp method for fitFfm Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2016-03-17 11:10:27 UTC (rev 4011) +++ pkg/FactorAnalytics/NAMESPACE 2016-03-17 12:15:03 UTC (rev 4012) @@ -11,6 +11,7 @@ S3method(fmCov,tsfm) S3method(fmEsDecomp,sfm) S3method(fmEsDecomp,tsfm) +S3method(fmSdDecomp,ffm) S3method(fmSdDecomp,sfm) S3method(fmSdDecomp,tsfm) S3method(fmVaRDecomp,sfm) Modified: pkg/FactorAnalytics/R/fmSdDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmSdDecomp.R 2016-03-17 11:10:27 UTC (rev 4011) +++ pkg/FactorAnalytics/R/fmSdDecomp.R 2016-03-17 12:15:03 UTC (rev 4012) @@ -1,167 +1,201 @@ -#' @title Decompose standard deviation into individual factor contributions -#' -#' @description Compute the factor contributions to standard deviation (SD) of -#' assets' returns based on Euler's theorem, given the fitted factor model. -#' -#' @details The factor model for an asset's return at time \code{t} has the -#' form \cr \cr \code{R(t) = beta'f(t) + e(t) = beta.star'f.star(t)} \cr \cr -#' where, \code{beta.star=(beta,sig.e)} and \code{f.star(t)=[f(t)',z(t)]'}. -#' \cr \cr By Euler's theorem, the standard deviation of the asset's return -#' is given as: \cr \cr -#' \code{Sd.fm = sum(cSd_k) = sum(beta.star_k*mSd_k)} \cr \cr -#' where, summation is across the \code{K} factors and the residual, -#' \code{cSd} and \code{mSd} are the component and marginal -#' contributions to \code{SD} respectively. Computing \code{Sd.fm} and -#' \code{mSd} is very straight forward. The formulas are given below and -#' details are in the references. The covariance term is approximated by the -#' sample covariance. \cr \cr -#' \code{Sd.fm = sqrt(beta.star''cov(F.star)beta.star)} \cr -#' \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 ... optional arguments passed to \code{\link[stats]{cov}}. -#' -#' @return A list containing -#' \item{Sd.fm}{length-N vector of factor model SDs of N-asset returns.} -#' \item{mSd}{N x (K+1) matrix of marginal contributions to SD.} -#' \item{cSd}{N x (K+1) matrix of component contributions to SD.} -#' \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 -#' -#' @references -#' Hallerback (2003). Decomposing Portfolio Value-at-Risk: A General Analysis. -#' The Journal of Risk, 5(2), 1-18. -#' -#' Meucci, A. (2007). Risk contributions from generic user-defined factors. -#' RISK-LONDON-RISK MAGAZINE LIMITED-, 20(6), 84. -#' -#' Yamai, Y., & Yoshiba, T. (2002). Comparative analyses of expected shortfall -#' and value-at-risk: their estimation error, decomposition, and optimization. -#' Monetary and economic studies, 20(1), 87-121. -#' -#' @seealso \code{\link{fitTsfm}}, \code{\link{fitSfm}}, \code{\link{fitFfm}} -#' for the different factor model fitting functions. -#' -#' \code{\link{fmCov}} for factor model covariance. -#' \code{\link{fmVaRDecomp}} for factor model VaR decomposition. -#' \code{\link{fmEsDecomp}} for factor model ES decomposition. -#' -#' @examples -#' # Time Series Factor Model -#' data(managers) -#' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]), -#' factor.names=colnames(managers[,(7:9)]), -#' rf.name="US.3m.TR", data=managers) -#' decomp <- fmSdDecomp(fit.macro) -#' # get the percentage component contributions -#' decomp$pcSd -#' -#' # Statistical Factor Model -#' data(StockReturns) -#' sfm.pca.fit <- fitSfm(r.M, k=2) -#' decomp <- fmSdDecomp(sfm.pca.fit) -#' decomp$pcSd -#' -#' @export - -fmSdDecomp <- function(object, ...){ - # check input object validity - if (!inherits(object, c("tsfm", "sfm", "ffm"))) { - stop("Invalid argument: Object should be of class 'tsfm', 'sfm' or 'ffm'.") - } - UseMethod("fmSdDecomp") -} - -## Remarks: -## The factor model for asset i's return has the form -## R(i,t) = beta_i'F(t) + e(i,t) = beta.star_i'F.star(t) -## where beta.star_i = (beta_i, sig.e_i)' and F.star(t) = (F(t)', z(t))' - -## Standard deviation of the asset i's return -## sd.fm_i = sqrt(beta.star_i'Cov(F.star)beta.star_i) - -## By Euler's theorem -## sd.fm_i = sum(cSd_i(k)) = sum(beta.star_i(k)*mSd_i(k)) -## where the sum is across the K factors + 1 residual term - -#' @rdname fmSdDecomp -#' @method fmSdDecomp tsfm -#' @export - -fmSdDecomp.tsfm <- function(object, use="pairwise.complete.obs", ...) { - - # get beta.star: N x (K+1) - beta <- object$beta - beta[is.na(beta)] <- 0 - beta.star <- as.matrix(cbind(beta, object$resid.sd)) - colnames(beta.star)[dim(beta.star)[2]] <- "residual" - - # get cov(F): K x K - factor <- as.matrix(object$data[, object$factor.names]) - factor.cov = cov(factor, use=use, ...) - - # 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") - - # compute factor model sd; a vector of length N - Sd.fm <- sqrt(rowSums(beta.star %*% factor.star.cov * beta.star)) - - # compute marginal, component and percentage contributions to sd - # each of these have dimensions: N x (K+1) - mSd <- (t(factor.star.cov %*% t(beta.star)))/Sd.fm - cSd <- mSd * beta.star - pcSd = 100* cSd/Sd.fm - - fm.sd.decomp <- list(Sd.fm=Sd.fm, mSd=mSd, cSd=cSd, pcSd=pcSd) - - return(fm.sd.decomp) -} - -#' @rdname fmSdDecomp -#' @method fmSdDecomp sfm -#' @export - -fmSdDecomp.sfm <- function(object, use="pairwise.complete.obs", ...) { - - # get beta.star: N x (K+1) - beta <- object$loadings - beta[is.na(beta)] <- 0 - beta.star <- as.matrix(cbind(beta, object$resid.sd)) - colnames(beta.star)[dim(beta.star)[2]] <- "residual" - - # get cov(F): K x K - factor <- as.matrix(object$factors) - factor.cov = cov(factor, use=use, ...) - - # 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") - - # compute factor model sd; a vector of length N - Sd.fm <- sqrt(rowSums(beta.star %*% factor.star.cov * beta.star)) - - # compute marginal, component and percentage contributions to sd - # each of these have dimensions: N x (K+1) - mSd <- (t(factor.star.cov %*% t(beta.star)))/Sd.fm - cSd <- mSd * beta.star - pcSd = 100* cSd/Sd.fm - - fm.sd.decomp <- list(Sd.fm=Sd.fm, mSd=mSd, cSd=cSd, pcSd=pcSd) - - return(fm.sd.decomp) -} - +#' @title Decompose standard deviation into individual factor contributions +#' +#' @description Compute the factor contributions to standard deviation (SD) of +#' assets' returns based on Euler's theorem, given the fitted factor model. +#' +#' @details The factor model for an asset's return at time \code{t} has the +#' form \cr \cr \code{R(t) = beta'f(t) + e(t) = beta.star'f.star(t)} \cr \cr +#' where, \code{beta.star=(beta,sig.e)} and \code{f.star(t)=[f(t)',z(t)]'}. +#' \cr \cr By Euler's theorem, the standard deviation of the asset's return +#' is given as: \cr \cr +#' \code{Sd.fm = sum(cSd_k) = sum(beta.star_k*mSd_k)} \cr \cr +#' where, summation is across the \code{K} factors and the residual, +#' \code{cSd} and \code{mSd} are the component and marginal +#' contributions to \code{SD} respectively. Computing \code{Sd.fm} and +#' \code{mSd} is very straight forward. The formulas are given below and +#' details are in the references. The covariance term is approximated by the +#' sample covariance. \cr \cr +#' \code{Sd.fm = sqrt(beta.star''cov(F.star)beta.star)} \cr +#' \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 ... optional arguments passed to \code{\link[stats]{cov}}. +#' +#' @return A list containing +#' \item{Sd.fm}{length-N vector of factor model SDs of N-asset returns.} +#' \item{mSd}{N x (K+1) matrix of marginal contributions to SD.} +#' \item{cSd}{N x (K+1) matrix of component contributions to SD.} +#' \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 +#' +#' @references +#' Hallerback (2003). Decomposing Portfolio Value-at-Risk: A General Analysis. +#' The Journal of Risk, 5(2), 1-18. +#' +#' Meucci, A. (2007). Risk contributions from generic user-defined factors. +#' RISK-LONDON-RISK MAGAZINE LIMITED-, 20(6), 84. +#' +#' Yamai, Y., & Yoshiba, T. (2002). Comparative analyses of expected shortfall +#' and value-at-risk: their estimation error, decomposition, and optimization. +#' Monetary and economic studies, 20(1), 87-121. +#' +#' @seealso \code{\link{fitTsfm}}, \code{\link{fitSfm}}, \code{\link{fitFfm}} +#' for the different factor model fitting functions. +#' +#' \code{\link{fmCov}} for factor model covariance. +#' \code{\link{fmVaRDecomp}} for factor model VaR decomposition. +#' \code{\link{fmEsDecomp}} for factor model ES decomposition. +#' +#' @examples +#' # Time Series Factor Model +#' data(managers) +#' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]), +#' factor.names=colnames(managers[,(7:9)]), +#' rf.name="US.3m.TR", data=managers) +#' decomp <- fmSdDecomp(fit.macro) +#' # get the percentage component contributions +#' decomp$pcSd +#' +#' # Statistical Factor Model +#' data(StockReturns) +#' sfm.pca.fit <- fitSfm(r.M, k=2) +#' decomp <- fmSdDecomp(sfm.pca.fit) +#' decomp$pcSd +#' +#' @export + +fmSdDecomp <- function(object, ...){ + # check input object validity + if (!inherits(object, c("tsfm", "sfm", "ffm"))) { + stop("Invalid argument: Object should be of class 'tsfm', 'sfm' or 'ffm'.") + } + UseMethod("fmSdDecomp") +} + +## Remarks: +## The factor model for asset i's return has the form +## R(i,t) = beta_i'F(t) + e(i,t) = beta.star_i'F.star(t) +## where beta.star_i = (beta_i, sig.e_i)' and F.star(t) = (F(t)', z(t))' + +## Standard deviation of the asset i's return +## sd.fm_i = sqrt(beta.star_i'Cov(F.star)beta.star_i) + +## By Euler's theorem +## sd.fm_i = sum(cSd_i(k)) = sum(beta.star_i(k)*mSd_i(k)) +## where the sum is across the K factors + 1 residual term + +#' @rdname fmSdDecomp +#' @method fmSdDecomp tsfm +#' @export + +fmSdDecomp.tsfm <- function(object, use="pairwise.complete.obs", ...) { + + # get beta.star: N x (K+1) + beta <- object$beta + beta[is.na(beta)] <- 0 + beta.star <- as.matrix(cbind(beta, object$resid.sd)) + colnames(beta.star)[dim(beta.star)[2]] <- "residual" + + # get cov(F): K x K + factor <- as.matrix(object$data[, object$factor.names]) + factor.cov = cov(factor, use=use, ...) + + # 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") + + # compute factor model sd; a vector of length N + Sd.fm <- sqrt(rowSums(beta.star %*% factor.star.cov * beta.star)) + + # compute marginal, component and percentage contributions to sd + # each of these have dimensions: N x (K+1) + mSd <- (t(factor.star.cov %*% t(beta.star)))/Sd.fm + cSd <- mSd * beta.star + pcSd = 100* cSd/Sd.fm + + fm.sd.decomp <- list(Sd.fm=Sd.fm, mSd=mSd, cSd=cSd, pcSd=pcSd) + + return(fm.sd.decomp) +} + +#' @rdname fmSdDecomp +#' @method fmSdDecomp sfm +#' @export + +fmSdDecomp.sfm <- function(object, use="pairwise.complete.obs", ...) { + + # get beta.star: N x (K+1) + beta <- object$loadings + beta[is.na(beta)] <- 0 + beta.star <- as.matrix(cbind(beta, object$resid.sd)) + colnames(beta.star)[dim(beta.star)[2]] <- "residual" + + # get cov(F): K x K + factor <- as.matrix(object$factors) + factor.cov = cov(factor, use=use, ...) + + # 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") + + # compute factor model sd; a vector of length N + Sd.fm <- sqrt(rowSums(beta.star %*% factor.star.cov * beta.star)) + + # compute marginal, component and percentage contributions to sd + # each of these have dimensions: N x (K+1) + mSd <- (t(factor.star.cov %*% t(beta.star)))/Sd.fm + cSd <- mSd * beta.star + pcSd = 100* cSd/Sd.fm + + fm.sd.decomp <- list(Sd.fm=Sd.fm, mSd=mSd, cSd=cSd, pcSd=pcSd) + + return(fm.sd.decomp) +} + +#' @rdname fmSdDecomp +#' @method fmSdDecomp ffm +#' @export + +fmSdDecomp.ffm <- function(object, ...) { + + # get beta.star: N x (K+1) + beta <- object$beta + beta.star <- as.matrix(cbind(beta, sqrt(object$resid.var))) + colnames(beta.star)[dim(beta.star)[2]] <- "residual" + + # get cov(F): K x K + factor.cov = object$factor.cov + + # 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") + + # compute factor model sd; a vector of length N + Sd.fm <- sqrt(rowSums(beta.star %*% factor.star.cov * beta.star)) + + # compute marginal, component and percentage contributions to sd + # each of these have dimensions: N x (K+1) + mSd <- (t(factor.star.cov %*% t(beta.star)))/Sd.fm + cSd <- mSd * beta.star + pcSd = 100* cSd/Sd.fm + + fm.sd.decomp <- list(Sd.fm=Sd.fm, mSd=mSd, cSd=cSd, pcSd=pcSd) + + return(fm.sd.decomp) +} Modified: pkg/FactorAnalytics/man/fmSdDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmSdDecomp.Rd 2016-03-17 11:10:27 UTC (rev 4011) +++ pkg/FactorAnalytics/man/fmSdDecomp.Rd 2016-03-17 12:15:03 UTC (rev 4012) @@ -2,6 +2,7 @@ % Please edit documentation in R/fmSdDecomp.R \name{fmSdDecomp} \alias{fmSdDecomp} +\alias{fmSdDecomp.ffm} \alias{fmSdDecomp.sfm} \alias{fmSdDecomp.tsfm} \title{Decompose standard deviation into individual factor contributions} @@ -11,6 +12,8 @@ \method{fmSdDecomp}{tsfm}(object, use = "pairwise.complete.obs", ...) \method{fmSdDecomp}{sfm}(object, use = "pairwise.complete.obs", ...) + +\method{fmSdDecomp}{ffm}(object, ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} From noreply at r-forge.r-project.org Thu Mar 17 15:23:11 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Mar 2016 15:23:11 +0100 (CET) Subject: [Returnanalytics-commits] r4013 - in pkg/FactorAnalytics: R man Message-ID: <20160317142312.0166A186E59@r-forge.r-project.org> Author: pragnya Date: 2016-03-17 15:23:11 +0100 (Thu, 17 Mar 2016) New Revision: 4013 Modified: pkg/FactorAnalytics/R/fmVaRDecomp.R pkg/FactorAnalytics/man/fmVaRDecomp.Rd Log: Add option to compute parametric VaR decomposition Modified: pkg/FactorAnalytics/R/fmVaRDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmVaRDecomp.R 2016-03-17 12:15:03 UTC (rev 4012) +++ pkg/FactorAnalytics/R/fmVaRDecomp.R 2016-03-17 14:23:11 UTC (rev 4013) @@ -2,9 +2,9 @@ #' #' @description Compute the factor contributions to Value-at-Risk (VaR) of #' assets' returns based on Euler's theorem, given the fitted factor model. -#' The partial derivative of VaR wrt factor beta is computed as the expected +#' The partial derivative of VaR w.r.t. factor beta is computed as the expected #' factor return given fund return is equal to its VaR and approximated by a -#' kernel estimator. VaR is computed as the sample quantile. +#' kernel estimator. Option to choose between non-parametric and Normal. #' #' @details The factor model for an asset's return at time \code{t} has the #' form \cr \cr \code{R(t) = beta'f(t) + e(t) = beta.star'f.star(t)} \cr \cr @@ -20,6 +20,13 @@ #' #' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}. #' @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 ... other optional arguments passed to \code{\link[stats]{quantile}}. #' #' @return A list containing @@ -81,8 +88,16 @@ #' @method fmVaRDecomp tsfm #' @export -fmVaRDecomp.tsfm <- function(object, p=0.95, ...) { +fmVaRDecomp.tsfm <- function(object, 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 @@ -94,6 +109,24 @@ 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 + factor.cov = cov(as.matrix(factors.xts), use=use, ...) + + # 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) @@ -107,12 +140,16 @@ rownames(mVaR)=rownames(cVaR)=rownames(pcVaR)=object$asset.names 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 - VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) + 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) + } # index of VaR exceedances idx.exceed[[i]] <- which(R.xts <= VaR.fm[i]) # number of VaR exceedances @@ -129,17 +166,22 @@ 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. - 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) + if (type=="np") { + # 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. + 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") { + mVaR[i,] <- t(MU) + SIGB[i,] * qnorm(1-p)/sd(R.xts, na.rm=TRUE) + } - # correction factor to ensure that sum(cVaR) = portfolio VaR + # correction factor to ensure that sum(cVaR) = asset VaR cf <- as.numeric( VaR.fm[i] / sum(mVaR[i,]*beta.star[i,], na.rm=TRUE) ) # compute marginal, component and percentage contributions to VaR @@ -159,8 +201,16 @@ #' @method fmVaRDecomp sfm #' @export -fmVaRDecomp.sfm <- function(object, p=0.95, ...) { +fmVaRDecomp.sfm <- function(object, 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$loadings beta[is.na(beta)] <- 0 @@ -172,6 +222,24 @@ 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 + factor.cov = cov(as.matrix(factors.xts), use=use, ...) + + # 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 <- object$k @@ -183,41 +251,43 @@ 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(paste("F",1:K,sep="."), - "residuals") + colnames(mVaR)=colnames(cVaR)=colnames(pcVaR)=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 - VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) + 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) + } # 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" - # 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. - 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) + if (type=="np") { + # 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. + 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") { + mVaR[i,] <- t(MU) + SIGB[i,] * qnorm(1-p)/sd(R.xts, na.rm=TRUE) + } - # correction factor to ensure that sum(cVaR) = portfolio VaR + # correction factor to ensure that sum(cVaR) = asset VaR cf <- as.numeric( VaR.fm[i] / sum(mVaR[i,]*beta.star[i,], na.rm=TRUE) ) # compute marginal, component and percentage contributions to VaR Modified: pkg/FactorAnalytics/man/fmVaRDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2016-03-17 12:15:03 UTC (rev 4012) +++ pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2016-03-17 14:23:11 UTC (rev 4013) @@ -8,9 +8,11 @@ \usage{ fmVaRDecomp(object, ...) -\method{fmVaRDecomp}{tsfm}(object, p = 0.95, ...) +\method{fmVaRDecomp}{tsfm}(object, p = 0.95, type = c("np", "normal"), + use = "pairwise.complete.obs", ...) -\method{fmVaRDecomp}{sfm}(object, p = 0.95, ...) +\method{fmVaRDecomp}{sfm}(object, 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}.} @@ -18,6 +20,15 @@ \item{...}{other optional arguments passed to \code{\link[stats]{quantile}}.} \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".} } \value{ A list containing @@ -33,9 +44,9 @@ \description{ Compute the factor contributions to Value-at-Risk (VaR) of assets' returns based on Euler's theorem, given the fitted factor model. -The partial derivative of VaR wrt factor beta is computed as the expected +The partial derivative of VaR w.r.t. factor beta is computed as the expected factor return given fund return is equal to its VaR and approximated by a -kernel estimator. VaR is computed as the sample quantile. +kernel estimator. Option to choose between non-parametric and Normal. } \details{ The factor model for an asset's return at time \code{t} has the From noreply at r-forge.r-project.org Thu Mar 17 15:28:52 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Mar 2016 15:28:52 +0100 (CET) Subject: [Returnanalytics-commits] r4014 - in pkg/FactorAnalytics: . R man Message-ID: <20160317142852.CB2271862BE@r-forge.r-project.org> Author: pragnya Date: 2016-03-17 15:28:52 +0100 (Thu, 17 Mar 2016) New Revision: 4014 Modified: pkg/FactorAnalytics/DESCRIPTION pkg/FactorAnalytics/R/fmEsDecomp.R pkg/FactorAnalytics/man/fmEsDecomp.Rd Log: Updated risk decompostion functions Modified: pkg/FactorAnalytics/DESCRIPTION =================================================================== --- pkg/FactorAnalytics/DESCRIPTION 2016-03-17 14:23:11 UTC (rev 4013) +++ pkg/FactorAnalytics/DESCRIPTION 2016-03-17 14:28:52 UTC (rev 4014) @@ -1,8 +1,8 @@ Package: factorAnalytics Type: Package Title: Factor Analytics -Version: 2.0.29 -Date: 2016-01-16 +Version: 2.0.30 +Date: 2016-03-17 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-03-17 14:23:11 UTC (rev 4013) +++ pkg/FactorAnalytics/R/fmEsDecomp.R 2016-03-17 14:28:52 UTC (rev 4014) @@ -4,8 +4,8 @@ #' Expected Shortfall (ES) of assets' returns based on Euler's theorem, given #' the fitted factor model. 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 computed as the sample -#' quantile. +#' than or equal to its value-at-risk (VaR). Option to choose between +#' non-parametric and Normal. #' #' @details The factor model for an asset's return at time \code{t} has the #' form \cr \cr \code{R(t) = beta'f(t) + e(t) = beta.star'f.star(t)} \cr \cr @@ -21,6 +21,13 @@ #' #' @param object fit object of class \code{tsfm}, \code{sfm} or \code{ffm}. #' @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 ... other optional arguments passed to \code{\link[stats]{quantile}}. #' #' @return A list containing @@ -84,8 +91,16 @@ #' @method fmEsDecomp tsfm #' @export -fmEsDecomp.tsfm <- function(object, p=0.95, ...) { +fmEsDecomp.tsfm <- function(object, 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 @@ -115,28 +130,29 @@ # return data for asset i R.xts <- object$data[,i] # get VaR for asset i - VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) + if (type=="np") { + 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]) # 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 ES as expected value of asset return, such that the given asset - # return is less than or equal to its value-at-risk (VaR) and approximated - # by a kernel estimator. - idx <- which(R.xts <= VaR.fm[i]) - ES.fm[i] <- mean(R.xts[idx], na.rm =TRUE) + # 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) - # compute marginal ES as expected value of factor returns, such that the - # given asset return is less than or equal to its value-at-risk (VaR) and - # approximated by a kernel estimator. - mES[i,] <- colMeans(factor.star[idx,], na.rm =TRUE) - - # correction factor to ensure that sum(cES) = portfolio ES + # correction factor to ensure that sum(cES) = asset ES cf <- as.numeric( ES.fm[i] / sum(mES[i,]*beta.star[i,], na.rm=TRUE) ) # compute marginal, component and percentage contributions to ES @@ -156,8 +172,16 @@ #' @method fmEsDecomp sfm #' @export -fmEsDecomp.sfm <- function(object, p=0.95, ...) { +fmEsDecomp.sfm <- function(object, 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$loadings beta[is.na(beta)] <- 0 @@ -188,28 +212,29 @@ # return data for asset i R.xts <- object$data[,i] # get VaR for asset i - VaR.fm[i] <- quantile(R.xts, probs=1-p, na.rm=TRUE, ...) + if (type=="np") { + 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]) # 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 ES as expected value of asset return, such that the given asset - # return is less than or equal to its value-at-risk (VaR) and approximated - # by a kernel estimator. - idx <- which(R.xts <= VaR.fm[i]) - ES.fm[i] <- mean(R.xts[idx], na.rm =TRUE) + # 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) - # compute marginal ES as expected value of factor returns, such that the - # given asset return is less than or equal to its value-at-risk (VaR) and - # approximated by a kernel estimator. - mES[i,] <- colMeans(factor.star[idx,], na.rm =TRUE) - - # correction factor to ensure that sum(cES) = portfolio ES + # correction factor to ensure that sum(cES) = asset ES cf <- as.numeric( ES.fm[i] / sum(mES[i,]*beta.star[i,], na.rm=TRUE) ) # compute marginal, component and percentage contributions to ES @@ -224,4 +249,3 @@ return(fm.ES.decomp) } - Modified: pkg/FactorAnalytics/man/fmEsDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmEsDecomp.Rd 2016-03-17 14:23:11 UTC (rev 4013) +++ pkg/FactorAnalytics/man/fmEsDecomp.Rd 2016-03-17 14:28:52 UTC (rev 4014) @@ -8,9 +8,9 @@ \usage{ fmEsDecomp(object, ...) -\method{fmEsDecomp}{tsfm}(object, p = 0.95, ...) +\method{fmEsDecomp}{tsfm}(object, p = 0.95, type = c("np", "normal"), ...) -\method{fmEsDecomp}{sfm}(object, p = 0.95, ...) +\method{fmEsDecomp}{sfm}(object, p = 0.95, type = c("np", "normal"), ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.} @@ -18,6 +18,9 @@ \item{...}{other optional arguments passed to \code{\link[stats]{quantile}}.} \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".} } \value{ A list containing @@ -35,8 +38,8 @@ Expected Shortfall (ES) of assets' returns based on Euler's theorem, given the fitted factor model. 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 computed as the sample -quantile. +than or equal to its value-at-risk (VaR). Option to choose between +non-parametric and Normal. } \details{ The factor model for an asset's return at time \code{t} has the From noreply at r-forge.r-project.org Thu Mar 17 15:33:46 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Mar 2016 15:33:46 +0100 (CET) Subject: [Returnanalytics-commits] r4015 - pkg/FactorAnalytics/tests Message-ID: <20160317143346.DD6E6186D83@r-forge.r-project.org> Author: pragnya Date: 2016-03-17 15:33:46 +0100 (Thu, 17 Mar 2016) New Revision: 4015 Added: pkg/FactorAnalytics/tests/FactorAnalytics_Manual_03_17_2016.pdf Removed: pkg/FactorAnalytics/tests/FactorAnalytics_06_04_2015.pdf Log: Updated package help manual Deleted: pkg/FactorAnalytics/tests/FactorAnalytics_06_04_2015.pdf =================================================================== (Binary files differ) Added: pkg/FactorAnalytics/tests/FactorAnalytics_Manual_03_17_2016.pdf =================================================================== (Binary files differ) Property changes on: pkg/FactorAnalytics/tests/FactorAnalytics_Manual_03_17_2016.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From noreply at r-forge.r-project.org Fri Mar 18 14:31:23 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Mar 2016 14:31:23 +0100 (CET) Subject: [Returnanalytics-commits] r4016 - in pkg/FactorAnalytics: . R man Message-ID: <20160318133123.4743E187D99@r-forge.r-project.org> Author: pragnya Date: 2016-03-18 14:31:22 +0100 (Fri, 18 Mar 2016) New Revision: 4016 Modified: pkg/FactorAnalytics/NAMESPACE pkg/FactorAnalytics/R/fmVaRDecomp.R pkg/FactorAnalytics/man/fmVaRDecomp.Rd Log: Adding FFM method to fmVaRDecomp Modified: pkg/FactorAnalytics/NAMESPACE =================================================================== --- pkg/FactorAnalytics/NAMESPACE 2016-03-17 14:33:46 UTC (rev 4015) +++ pkg/FactorAnalytics/NAMESPACE 2016-03-18 13:31:22 UTC (rev 4016) @@ -14,6 +14,7 @@ S3method(fmSdDecomp,ffm) S3method(fmSdDecomp,sfm) S3method(fmSdDecomp,tsfm) +S3method(fmVaRDecomp,ffm) S3method(fmVaRDecomp,sfm) S3method(fmVaRDecomp,tsfm) S3method(plot,pafm) Modified: pkg/FactorAnalytics/R/fmVaRDecomp.R =================================================================== --- pkg/FactorAnalytics/R/fmVaRDecomp.R 2016-03-17 14:33:46 UTC (rev 4015) +++ pkg/FactorAnalytics/R/fmVaRDecomp.R 2016-03-18 13:31:22 UTC (rev 4016) @@ -303,3 +303,107 @@ return(fm.VaR.decomp) } +#' @rdname fmVaRDecomp +#' @method fmVaRDecomp ffm +#' @export + +fmVaRDecomp.ffm <- function(object, p=0.95, type=c("np","normal"), ...) { + + # 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 + factor.cov = object$factor.cov + + # 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) + idx.exceed <- list() + n.exceed <- rep(NA, N) + names(VaR.fm) = names(n.exceed) = object$asset.names + mVaR <- matrix(NA, N, K+1) + 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") + 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) + } + # 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") { + # 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. + 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") { + mVaR[i,] <- t(MU) + SIGB[i,] * qnorm(1-p)/sd(R.xts, na.rm=TRUE) + } + + # correction factor to ensure that sum(cVaR) = asset VaR + cf <- as.numeric( VaR.fm[i] / sum(mVaR[i,]*beta.star[i,], na.rm=TRUE) ) + + # compute marginal, component and percentage contributions to VaR + # each of these have dimensions: N x (K+1) + mVaR[i,] <- cf * mVaR[i,] + cVaR[i,] <- mVaR[i,] * beta.star[i,] + pcVaR[i,] <- 100* cVaR[i,] / VaR.fm[i] + } + + fm.VaR.decomp <- list(VaR.fm=VaR.fm, n.exceed=n.exceed, idx.exceed=idx.exceed, + mVaR=mVaR, cVaR=cVaR, pcVaR=pcVaR) + + return(fm.VaR.decomp) +} Modified: pkg/FactorAnalytics/man/fmVaRDecomp.Rd =================================================================== --- pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2016-03-17 14:33:46 UTC (rev 4015) +++ pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2016-03-18 13:31:22 UTC (rev 4016) @@ -2,6 +2,7 @@ % Please edit documentation in R/fmVaRDecomp.R \name{fmVaRDecomp} \alias{fmVaRDecomp} +\alias{fmVaRDecomp.ffm} \alias{fmVaRDecomp.sfm} \alias{fmVaRDecomp.tsfm} \title{Decompose VaR into individual factor contributions} @@ -13,6 +14,8 @@ \method{fmVaRDecomp}{sfm}(object, p = 0.95, type = c("np", "normal"), use = "pairwise.complete.obs", ...) + +\method{fmVaRDecomp}{ffm}(object, p = 0.95, type = c("np", "normal"), ...) } \arguments{ \item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.}