[Returnanalytics-commits] r3563 - in pkg/FactorAnalytics: . R man vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 26 00:37:06 CET 2014
Author: pragnya
Date: 2014-11-26 00:37:06 +0100 (Wed, 26 Nov 2014)
New Revision: 3563
Added:
pkg/FactorAnalytics/R/predict.sfm.r
pkg/FactorAnalytics/R/print.sfm.r
pkg/FactorAnalytics/R/summary.sfm.r
pkg/FactorAnalytics/man/predict.sfm.Rd
pkg/FactorAnalytics/man/print.sfm.Rd
pkg/FactorAnalytics/man/summary.sfm.Rd
Modified:
pkg/FactorAnalytics/NAMESPACE
pkg/FactorAnalytics/R/fitSfm.R
pkg/FactorAnalytics/R/fitTsfm.R
pkg/FactorAnalytics/R/fmCov.R
pkg/FactorAnalytics/R/fmEsDecomp.R
pkg/FactorAnalytics/R/fmSdDecomp.R
pkg/FactorAnalytics/R/fmVaRDecomp.R
pkg/FactorAnalytics/R/paFm.r
pkg/FactorAnalytics/man/fitSfm.Rd
pkg/FactorAnalytics/man/fmCov.Rd
pkg/FactorAnalytics/man/fmEsDecomp.Rd
pkg/FactorAnalytics/man/fmSdDecomp.Rd
pkg/FactorAnalytics/man/fmVaRDecomp.Rd
pkg/FactorAnalytics/vignettes/fitTsfm_vignette.Rnw
pkg/FactorAnalytics/vignettes/fitTsfm_vignette.pdf
Log:
Added method functions for fitSfm. Updated fitTsfm vignette
Modified: pkg/FactorAnalytics/NAMESPACE
===================================================================
--- pkg/FactorAnalytics/NAMESPACE 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/NAMESPACE 2014-11-25 23:37:06 UTC (rev 3563)
@@ -4,19 +4,27 @@
S3method(coef,tsfm)
S3method(fitted,sfm)
S3method(fitted,tsfm)
+S3method(fmCov,sfm)
S3method(fmCov,tsfm)
+S3method(fmEsDecomp,sfm)
S3method(fmEsDecomp,tsfm)
+S3method(fmSdDecomp,sfm)
S3method(fmSdDecomp,tsfm)
+S3method(fmVaRDecomp,sfm)
S3method(fmVaRDecomp,tsfm)
S3method(plot,pafm)
S3method(plot,tsfm)
+S3method(predict,sfm)
S3method(predict,tsfm)
S3method(print,pafm)
+S3method(print,sfm)
+S3method(print,summary.sfm)
S3method(print,summary.tsfm)
S3method(print,tsfm)
S3method(residuals,sfm)
S3method(residuals,tsfm)
S3method(summary,pafm)
+S3method(summary,sfm)
S3method(summary,tsfm)
export(dCornishFisher)
export(fitSfm)
@@ -43,9 +51,11 @@
importFrom(lattice,panel.barchart)
importFrom(lattice,panel.grid)
importFrom(leaps,regsubsets)
+importFrom(lmtest,coeftest)
importFrom(lmtest,coeftest.default)
importFrom(robust,lmRob)
importFrom(robust,step.lmRob)
importFrom(sandwich,vcovHAC.default)
+importFrom(sandwich,vcovHC)
importFrom(sandwich,vcovHC.default)
importFrom(strucchange,efp)
Modified: pkg/FactorAnalytics/R/fitSfm.R
===================================================================
--- pkg/FactorAnalytics/R/fitSfm.R 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/R/fitSfm.R 2014-11-25 23:37:06 UTC (rev 3563)
@@ -68,8 +68,7 @@
#' \item{r2}{length-N vector of R-squared values.}
#' \item{resid.sd}{length-N vector of residual standard deviations.}
#' \item{residuals}{T x N xts object of residuals from the OLS regression.}
-#' \item{Omega}{M x M return covariance matrix estimated by the factor model,
-#' where M = min(N,T).}
+#' \item{Omega}{N x N return covariance matrix estimated by the factor model.}
#' \item{eigen}{length-K vector of eigenvalues of the sample covariance matrix.}
#' \item{mimic}{N x K matrix of factor mimicking portfolio weights.}
#' \item{call}{the matched function call.}
@@ -131,13 +130,13 @@
#' sfm.pca.fit$mimic
#'
#' # apca with number of factors, k=15
-#' # sfm.apca.fit <- fitSfm(sfm.apca.dat, k=15, refine=TRUE)
+#' sfm.apca.fit <- fitSfm(sfm.apca.dat, k=15, refine=TRUE)
#'
#' # apca with the Bai & Ng method
#' sfm.apca.fit.bn <- fitSfm(sfm.apca.dat, k="bn")
#'
#' # apca with the Connor-Korajczyk method
-#' # sfm.apca.fit.ck <- fitSfm(sfm.apca.dat, k="ck")
+#' sfm.apca.fit.ck <- fitSfm(sfm.apca.dat, k="ck")
#'
#' @importFrom PerformanceAnalytics checkData
#'
@@ -254,6 +253,7 @@
# assign row and column names
names(eig.val) = names(r2) = names(resid.sd) = colnames(R.xts)
+ colnames(B) <- colnames(f)
# return list
list(asset.fit=asset.fit, k=k, factors=f, loadings=B, alpha=alpha, r2=r2,
@@ -313,6 +313,7 @@
# assign row and column names
names(eig.val) = 1:obs
names(r2) = names(resid.sd) = colnames(R.xts)
+ colnames(B) <- colnames(f)
# return list
list(asset.fit=asset.fit, k=k, factors=f, loadings=B, alpha=alpha, r2=r2,
@@ -338,7 +339,7 @@
# dof-adjusted squared residuals for k
fit <- UseAPCA(R.xts=R.xts, R.mat=R.mat, k=k, n=n, obs=obs, refine=refine)
eps2.star <- fit$residuals^2 / (1-(k+1)/obs-k/n)
- mu.star <- rowMeans(eps2[idx,,drop=FALSE])
+ mu.star <- rowMeans(eps2.star[idx,,drop=FALSE])
# cross sectional differences in sqd. errors btw odd & even time periods
delta <- mu - mu.star
# test for a positive mean value for Delta
@@ -397,6 +398,7 @@
#' @export
fitted.sfm <- function(object, ...) {
+ # use residuals already computed via fitSfm function
fitted.xts <- object$data - object$residuals
return(fitted.xts)
}
@@ -406,5 +408,6 @@
#' @export
residuals.sfm <- function(object, ...) {
+ # already computed via fitSfm function
return(object$residuals)
}
Modified: pkg/FactorAnalytics/R/fitTsfm.R
===================================================================
--- pkg/FactorAnalytics/R/fitTsfm.R 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/R/fitTsfm.R 2014-11-25 23:37:06 UTC (rev 3563)
@@ -233,8 +233,7 @@
dat.xts <- "[<-"(dat.xts,,vapply(dat.xts, function(x) x-data.xts[,rf.name],
FUN.VALUE = numeric(nrow(dat.xts))))
} else {
- warning("Excess returns were not computed. Returns data were used as input
- for all factors and assets.")
+ warning("Excess returns were not computed.")
}
# opt add mkt-timing factors: up.market=max(0,Rm-Rf), market.sqd=(Rm-Rf)^2
@@ -290,7 +289,7 @@
tmp <- matrix(NA, length(asset.names), length(factor.names))
colnames(tmp) <- factor.names
rownames(tmp) <- asset.names
- beta <- merge(beta, tmp, all.x=TRUE, sort=FALSE)[,factor.names]
+ beta <- merge(beta, tmp, all.x=TRUE, sort=FALSE)[,factor.names, drop=FALSE]
rownames(beta) <- asset.names
# extract r2 and residual sd
r2 <- sapply(reg.list, function(x) summary(x)$r.squared)
Modified: pkg/FactorAnalytics/R/fmCov.R
===================================================================
--- pkg/FactorAnalytics/R/fmCov.R 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/R/fmCov.R 2014-11-25 23:37:06 UTC (rev 3563)
@@ -52,18 +52,12 @@
#' factor.names=c("EDHEC LS EQ","SP500 TR"), data=managers)
#' fmCov(fit)
#'
-#' \dontrun{
#' # Statistical Factor Model
#' data(stat.fm.data)
#' sfm.pca.fit <- fitSfm(sfm.dat, k=2)
-#' #' fmCov(t(sfm.pca.fit$loadings), var(sfm.pca.fit$factors),
-#' sfm.pca.fit$resid.sd)
-#'
-#' sfm.apca.fit <- fitSfm(sfm.apca.dat, k=2)
-#'
-#' fmCov(t(sfm.apca.fit$loadings), var(sfm.apca.fit$factors),
-#' sfm.apca.fit$resid.sd)
-#'
+#' fmCov(sfm.pca.fit)
+#'
+#' \dontrun{
#' # Fundamental Factor Model
#' data(stock)
#' # there are 447 assets
@@ -121,3 +115,14 @@
return(cov.fm)
}
+
+#' @rdname fmCov
+#' @method fmCov sfm
+#' @export
+
+fmCov.sfm <- function(object, use="pairwise.complete.obs", ...) {
+
+ # already computed via fitSfm function
+ return(object$Omega)
+}
+
Modified: pkg/FactorAnalytics/R/fmEsDecomp.R
===================================================================
--- pkg/FactorAnalytics/R/fmEsDecomp.R 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/R/fmEsDecomp.R 2014-11-25 23:37:06 UTC (rev 3563)
@@ -73,11 +73,16 @@
#' data(managers)
#' fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]),
#' factor.names=colnames(managers[,(7:8)]), data=managers)
-#'
#' ES.decomp <- fmEsDecomp(fit.macro)
#' # get the component contributions
#' ES.decomp$cES
#'
+#' # Statistical Factor Model
+#' data(stat.fm.data)
+#' sfm.pca.fit <- fitSfm(sfm.dat, k=2)
+#' ES.decomp <- fmEsDecomp(sfm.pca.fit)
+#' ES.decomp$cES
+#'
#' @importFrom PerformanceAnalytics VaR
#'
#' @export
@@ -173,3 +178,89 @@
return(fm.ES.decomp)
}
+
+#' @rdname fmEsDecomp
+#' @method fmEsDecomp sfm
+#' @export
+
+fmEsDecomp.sfm <- function(object, p=0.95,
+ method=c("modified","gaussian","historical",
+ "kernel"), invert=FALSE, ...) {
+
+ # set defaults and check input vailidity
+ method = method[1]
+
+ if (!(method %in% c("modified", "gaussian", "historical", "kernel"))) {
+ stop("Invalid argument: method must be 'modified', 'gaussian',
+ 'historical' or 'kernel'")
+ }
+
+ # get beta.star
+ 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"
+
+ # factor returns and residuals data
+ factors.xts <- object$factors
+ resid.xts <- as.xts(t(t(residuals(object))/object$resid.sd))
+ time(resid.xts) <- as.Date(time(resid.xts))
+
+ # 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
+ 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")
+
+ for (i in object$asset.names) {
+ # return data for asset i
+ R.xts <- object$data[,i]
+ # get VaR for asset i
+ VaR.fm[i] <- VaR(R.xts, p=p, method=method, invert=invert, ...)
+ # 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 (!invert) {inv=-1} else {inv=1}
+
+ # 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 <= inv*VaR.fm[i])
+ ES.fm[i] <- inv * mean(R.xts[idx], 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,] <- inv * colMeans(factor.star[idx,], na.rm =TRUE)
+
+ # correction factor to ensure that sum(cES) = portfolio ES
+ cf <- as.numeric( ES.fm[i] / sum(mES[i,]*beta.star[i,], na.rm=TRUE) )
+
+ # 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(VaR.fm=VaR.fm, n.exceed=n.exceed, idx.exceed=idx.exceed,
+ ES.fm=ES.fm, mES=mES, cES=cES, pcES=pcES)
+
+ return(fm.ES.decomp)
+}
+
Modified: pkg/FactorAnalytics/R/fmSdDecomp.R
===================================================================
--- pkg/FactorAnalytics/R/fmSdDecomp.R 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/R/fmSdDecomp.R 2014-11-25 23:37:06 UTC (rev 3563)
@@ -59,10 +59,15 @@
#' 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(stat.fm.data)
+#' sfm.pca.fit <- fitSfm(sfm.dat, k=2)
+#' decomp <- fmSdDecomp(sfm.pca.fit)
+#' decomp$pcSd
#'
#' @export
@@ -122,3 +127,41 @@
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)
+}
+
Modified: pkg/FactorAnalytics/R/fmVaRDecomp.R
===================================================================
--- pkg/FactorAnalytics/R/fmVaRDecomp.R 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/R/fmVaRDecomp.R 2014-11-25 23:37:06 UTC (rev 3563)
@@ -73,6 +73,12 @@
#' # get the component contributions
#' VaR.decomp$cVaR
#'
+#' # Statistical Factor Model
+#' data(stat.fm.data)
+#' sfm.pca.fit <- fitSfm(sfm.dat, k=2)
+#' VaR.decomp <- fmVaRDecomp(sfm.pca.fit)
+#' VaR.decomp$cVaR
+#'
#' @importFrom PerformanceAnalytics VaR
#'
#' @export
@@ -174,3 +180,94 @@
return(fm.VaR.decomp)
}
+
+#' @rdname fmVaRDecomp
+#' @method fmVaRDecomp sfm
+#' @export
+
+fmVaRDecomp.sfm <- function(object, p=0.95,
+ method=c("modified","gaussian","historical",
+ "kernel"), invert=FALSE, ...) {
+
+ # set defaults and check input vailidity
+ method = method[1]
+
+ if (!(method %in% c("modified", "gaussian", "historical", "kernel"))) {
+ stop("Invalid argument: method must be 'modified', 'gaussian',
+ 'historical' or 'kernel'")
+ }
+
+ # get beta.star
+ 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"
+
+ # factor returns and residuals data
+ factors.xts <- object$factors
+ resid.xts <- as.xts(t(t(residuals(object))/object$resid.sd))
+ time(resid.xts) <- as.Date(time(resid.xts))
+
+ # initialize lists and matrices
+ N <- length(object$asset.names)
+ K <- object$k
+ 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(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] <- VaR(R.xts, p=p, method=method, invert=invert, ...)
+ # 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 (!invert) {inv=-1} else {inv=1}
+
+ # 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,] <- inv * colMeans(factor.star*k.weight, na.rm =TRUE)
+
+ # correction factor to ensure that sum(cVaR) = portfolio 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/R/paFm.r
===================================================================
--- pkg/FactorAnalytics/R/paFm.r 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/R/paFm.r 2014-11-25 23:37:06 UTC (rev 3563)
@@ -158,21 +158,21 @@
if (class(fit)=="sfm") {
# return attributed to factors
- cum.attr.ret <- t(fit$loadings)
+ cum.attr.ret <- fit$loadings
cum.spec.ret <- fit$r2
- factorNames <- rownames(fit$loadings)
- fundNames <- colnames(fit$loadings)
+ factorNames <- colnames(fit$loadings)
+ fundNames <- rownames(fit$loadings)
data <- checkData(fit$data)
# create list for attribution
attr.list <- list()
# pca method
- if ( dim(fit$asset.ret)[1] > dim(fit$asset.ret)[2] ) {
+ if ( dim(fit$data)[1] > dim(fit$data)[2] ) {
for (k in fundNames) {
fit.lm <- fit$asset.fit[[k]]
## extract information from lm object
- date <- index(data[, k])
+ date <- index(data[,k])
# probably needs more general Date setting
actual.xts <- xts(fit.lm$model[1], as.Date(date))
# attributed returns
@@ -181,11 +181,11 @@
# setup initial value
attr.ret.xts.all <- xts(, as.Date(date))
- for ( i in factorNames ) {
+ for (i in factorNames) {
attr.ret.xts <- actual.xts -
xts(as.matrix(fit.lm$model[i])%*%as.matrix(fit.lm$coef[i]),
as.Date(date))
- cum.attr.ret[k, i] <- cum.ret -
+ cum.attr.ret[k,i] <- cum.ret -
Return.cumulative(actual.xts - attr.ret.xts)
attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts)
}
@@ -194,31 +194,30 @@
spec.ret.xts <- actual.xts -
xts(as.matrix(fit.lm$model[, -1])%*%as.matrix(fit.lm$coef[-1]),
as.Date(date))
- cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts)
+ cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts- spec.ret.xts)
attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts)
colnames(attr.list[[k]]) <- c(factorNames, "specific.returns")
}
} else {
# apca method:
- # fit$loadings # f X K
- # fit$factors # T X f
+ # fit$loadings # N X K
+ # fit$factors # T X K
date <- index(fit$factors)
- for ( k in fundNames) {
+ for (k in fundNames) {
attr.ret.xts.all <- xts(, as.Date(date))
- actual.xts <- xts(fit$asset.ret[, k], as.Date(date))
- cum.ret <- Return.cumulative(actual.xts)
+ actual.xts <- xts(fit$data[,k], as.Date(date))
+ cum.ret <- Return.cumulative(actual.xts)
for (i in factorNames) {
- attr.ret.xts <- xts(fit$factors[, i] * fit$loadings[i, k],
- as.Date(date))
+ attr.ret.xts <- xts(fit$factors[,i]*fit$loadings[k,i], as.Date(date))
attr.ret.xts.all <- merge(attr.ret.xts.all, attr.ret.xts)
- cum.attr.ret[k, i] <- cum.ret - Return.cumulative(actual.xts -
- attr.ret.xts)
+ cum.attr.ret[k,i] <- cum.ret - Return.cumulative(actual.xts -
+ attr.ret.xts)
}
- spec.ret.xts <- actual.xts - xts(fit$factors%*%fit$loadings[, k],
+ spec.ret.xts <- actual.xts - xts(fit$factors%*%t(fit$loadings[k,]),
as.Date(date))
- cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts-spec.ret.xts)
+ cum.spec.ret[k] <- cum.ret - Return.cumulative(actual.xts- spec.ret.xts)
attr.list[[k]] <- merge(attr.ret.xts.all, spec.ret.xts)
colnames(attr.list[[k]]) <- c(factorNames, "specific.returns")
}
@@ -226,7 +225,7 @@
}
ans <- list(cum.ret.attr.f=cum.attr.ret, cum.spec.ret=cum.spec.ret,
- attr.list=attr.list)
+ attr.list=attr.list)
class(ans) <- "pafm"
return(ans)
}
Added: pkg/FactorAnalytics/R/predict.sfm.r
===================================================================
--- pkg/FactorAnalytics/R/predict.sfm.r (rev 0)
+++ pkg/FactorAnalytics/R/predict.sfm.r 2014-11-25 23:37:06 UTC (rev 3563)
@@ -0,0 +1,43 @@
+#' @title Predicts asset returns based on a fitted statistical factor model
+#'
+#' @description S3 \code{predict} method for object of class \code{sfm}. It
+#' calls the \code{predict} method for fitted objects of class \code{lm}.
+#'
+#' @param object an object of class \code{sfm} produced by \code{fitSfm}.
+#' @param newdata a vector, matrix, data.frame, xts, timeSeries or zoo object
+#' containing the variables with which to predict.
+#' @param ... optional arguments passed to \code{predict.lm}.
+#'
+#' @return
+#' \code{predict.sfm} produces a vector or a matrix of predictions.
+#'
+#' @author Yi-An Chen and Sangeetha Srinivasan
+#'
+#' @seealso \code{\link{fitSfm}}, \code{\link{summary.sfm}}
+#'
+#' @examples
+#' # load data from the database
+#' data(stat.fm.data)
+#' # fit the factor model with PCA
+#' fit <- fitSfm(sfm.dat, k=2)
+#'
+#' pred.fit <- predict(fit)
+#' newdata <- data.frame("EDHEC LS EQ"=rnorm(n=120), "SP500 TR"=rnorm(n=120))
+#' rownames(newdata) <- rownames(fit$data)
+#' pred.fit2 <- predict(fit, newdata, interval="confidence")
+#'
+#' @importFrom PerformanceAnalytics checkData
+#'
+#' @method predict sfm
+#' @export
+#'
+
+predict.sfm <- function(object, newdata = NULL, ...){
+
+ if (missing(newdata) || is.null(newdata)) {
+ predict(object$asset.fit, ...)
+ } else {
+ newdata <- checkData(newdata, method="data.frame")
+ predict(object$asset.fit, newdata, ...)
+ }
+}
\ No newline at end of file
Added: pkg/FactorAnalytics/R/print.sfm.r
===================================================================
--- pkg/FactorAnalytics/R/print.sfm.r (rev 0)
+++ pkg/FactorAnalytics/R/print.sfm.r 2014-11-25 23:37:06 UTC (rev 3563)
@@ -0,0 +1,40 @@
+#' @title Prints out a fitted statictical factor model object
+#'
+#' @description S3 \code{print} method for object of class \code{sfm}. Prints
+#' the call, factor model dimension, factor loadings, r-squared and residual
+#' volatilities from the fitted object.
+#'
+#' @param x an object of class \code{sfm} produced by \code{fitSfm}.
+#' @param digits an integer value, to indicate the required number of
+#' significant digits. Default is 3.
+#' @param ... optional arguments passed to the \code{print} method.
+#'
+#' @author Yi-An Chen and Sangeetha Srinivasan
+#'
+#' @seealso \code{\link{fitSfm}}, \code{\link{summary.sfm}}
+#'
+#' @examples
+#' data(stat.fm.data)
+#' fit <- fitSfm(sfm.dat, k=2)
+#' print(fit)
+#'
+#' @method print sfm
+#' @export
+#'
+
+print.sfm <- function(x, digits=max(3, .Options$digits - 3), ...){
+ if(!is.null(cl <- x$call)){
+ cat("\nCall:\n")
+ dput(cl)
+ }
+ cat("\nModel dimensions:\n")
+ tmp <- c(dim(t(x$loadings)), nrow(x$data))
+ names(tmp) <- c("Factors", "Assets", "Periods")
+ print(tmp)
+ cat("\nFactor Loadings:\n")
+ print(summary(x$loadings), digits=digits, ...)
+ cat("\nR-squared values:\n")
+ print(summary(x$r2), digits=digits, ...)
+ cat("\nResidual Volatilities:\n")
+ print(summary(x$resid.sd), digits=digits, ...)
+}
Added: pkg/FactorAnalytics/R/summary.sfm.r
===================================================================
--- pkg/FactorAnalytics/R/summary.sfm.r (rev 0)
+++ pkg/FactorAnalytics/R/summary.sfm.r 2014-11-25 23:37:06 UTC (rev 3563)
@@ -0,0 +1,96 @@
+#' @title Summarizing a fitted time series factor model
+#'
+#' @description \code{summary} method for object of class \code{sfm}.
+#' Returned object is of class {summary.sfm}.
+#'
+#' @details The default \code{summary} method for a fitted \code{lm} object
+#' computes the standard errors and t-statistics under the assumption of
+#' homoskedasticty. Argument \code{se.type} gives the option to compute
+#' heteroskedasticity-consistent (HC) standard errors and t-statistics using
+#' \code{\link[lmtest]{coeftest}}.
+#'
+#' @param object an object of class \code{sfm} returned by \code{fitSfm}.
+#' @param se.type one of "Default" or "HC"; option for computing HC standard
+#' errors and t-statistics.
+#' @param x an object of class \code{summary.sfm}.
+#' @param digits number of significants digits to use when printing.
+#' Default is 3.
+#' @param ... futher arguments passed to or from other methods.
+#'
+#' @return Returns an object of class \code{summary.sfm}.
+#' The print method for class \code{summary.sfm} 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.sfm} is a list of length N+2 containing:
+#' \item{call}{the function call to \code{fitSfm}}
+#' \item{se.type}{standard error type as input}
+#' \item{}{summary of the fit object of class \code{mlm} for the factor model.}
+#'
+#' @note For a more detailed printed summary for each asset, refer to
+#' \code{\link[stats]{summary.lm}}, which includes F-statistics,
+#' Multiple R-squared, Adjusted R-squared, further formats the coefficients,
+#' standard errors, etc. and additionally gives significance stars if
+#' \code{signif.stars} is TRUE.
+#'
+#' @author Sangeetha Srinivasan
+#'
+#' @seealso \code{\link{fitSfm}}, \code{\link[stats]{summary.lm}}
+#'
+#' @examples
+#' data(stat.fm.data)
+#' # fit the factor model with PCA
+#' fit <- fitSfm(sfm.dat, k=2)
+#'
+#' # summary of factor model fit for all assets
+#' summary(fit, "HAC")
+#'
+#' @importFrom lmtest coeftest
+#' @importFrom sandwich vcovHC
+#'
+#' @method summary sfm
+#' @export
+
+summary.sfm <- function(object, se.type="Default", ...){
+
+ # check input object validity
+ if (!inherits(object, "sfm")) {
+ stop("Invalid 'sfm' object")
+ }
+
+ # extract list of mlm summary object for the entire model
+ mlm.fit.summary <- summary(object$asset.fit)
+
+ # get coefficients and convert to HC standard errors and t-stats if specified
+ coefficients <- coeftest(object$asset.fit, vcov.=vcovHC, data=sfm.data[,1])
+ if (se.type=="HC") {
+ coefficients <- coeftest(object$asset.fit, vcov.=vcovHC)
+ }
+
+ # include the call and se.type to fitSfm
+ sum <- list(call=object$call, se.type=se.type, coefficients=coefficients,
+ mlm.fit.summary=mlm.fit.summary, r.squared=object$r2,
+ sigma=object$resid.sd)
+ class(sum) <- "summary.sfm"
+ return(sum)
+}
+
+#' @rdname summary.sfm
+#' @method print summary.sfm
+#' @export
+
+print.summary.sfm <- function(x, digits=3, ...) {
+
+ if(!is.null(cl <- x$call)) {
+ cat("\nCall:\n")
+ dput(cl)
+ }
+ cat("\nFactor Model Coefficients:", "\n(", x$se.type,
+ " Standard Errors & T-stats)\n\n", sep="")
+ c <- x$coefficients
+ print(c, digits=digits, ...)
+ r2 <- x$r.squared
+ print(r2, digits=digits, ...)
+ sig <- x$sigma
+ print(sig, digits=digits, ...)
+}
Modified: pkg/FactorAnalytics/man/fitSfm.Rd
===================================================================
--- pkg/FactorAnalytics/man/fitSfm.Rd 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/man/fitSfm.Rd 2014-11-25 23:37:06 UTC (rev 3563)
@@ -36,6 +36,8 @@
\item{object}{a fit object of class \code{sfm} which is returned by
\code{fitSfm}}
+
+\item{...}{arguments passed to other functions.}
}
\value{
fitTsfm returns an object of class \code{"sfm"} for which
@@ -58,8 +60,7 @@
\item{r2}{length-N vector of R-squared values.}
\item{resid.sd}{length-N vector of residual standard deviations.}
\item{residuals}{T x N xts object of residuals from the OLS regression.}
-\item{Omega}{M x M return covariance matrix estimated by the factor model,
-where M = min(N,T).}
+\item{Omega}{N x N return covariance matrix estimated by the factor model.}
\item{eigen}{length-K vector of eigenvalues of the sample covariance matrix.}
\item{mimic}{N x K matrix of factor mimicking portfolio weights.}
\item{call}{the matched function call.}
Modified: pkg/FactorAnalytics/man/fmCov.Rd
===================================================================
--- pkg/FactorAnalytics/man/fmCov.Rd 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/man/fmCov.Rd 2014-11-25 23:37:06 UTC (rev 3563)
@@ -1,12 +1,15 @@
% Generated by roxygen2 (4.0.2): do not edit by hand
\name{fmCov}
\alias{fmCov}
+\alias{fmCov.sfm}
\alias{fmCov.tsfm}
\title{Covariance Matrix for assets' returns from fitted factor model.}
\usage{
fmCov(object, ...)
\method{fmCov}{tsfm}(object, use = "pairwise.complete.obs", ...)
+
+\method{fmCov}{sfm}(object, use = "pairwise.complete.obs", ...)
}
\arguments{
\item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.}
@@ -55,18 +58,12 @@
factor.names=c("EDHEC LS EQ","SP500 TR"), data=managers)
fmCov(fit)
-\dontrun{
# Statistical Factor Model
data(stat.fm.data)
sfm.pca.fit <- fitSfm(sfm.dat, k=2)
-#' fmCov(t(sfm.pca.fit$loadings), var(sfm.pca.fit$factors),
- sfm.pca.fit$resid.sd)
+fmCov(sfm.pca.fit)
-sfm.apca.fit <- fitSfm(sfm.apca.dat, k=2)
-
-fmCov(t(sfm.apca.fit$loadings), var(sfm.apca.fit$factors),
- sfm.apca.fit$resid.sd)
-
+\dontrun{
# Fundamental Factor Model
data(stock)
# there are 447 assets
Modified: pkg/FactorAnalytics/man/fmEsDecomp.Rd
===================================================================
--- pkg/FactorAnalytics/man/fmEsDecomp.Rd 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/man/fmEsDecomp.Rd 2014-11-25 23:37:06 UTC (rev 3563)
@@ -1,6 +1,7 @@
% Generated by roxygen2 (4.0.2): do not edit by hand
\name{fmEsDecomp}
\alias{fmEsDecomp}
+\alias{fmEsDecomp.sfm}
\alias{fmEsDecomp.tsfm}
\title{Decompose ES into individual factor contributions}
\usage{
@@ -8,6 +9,9 @@
\method{fmEsDecomp}{tsfm}(object, p = 0.95, method = c("modified",
"gaussian", "historical", "kernel"), invert = FALSE, ...)
+
+\method{fmEsDecomp}{sfm}(object, p = 0.95, method = c("modified",
+ "gaussian", "historical", "kernel"), invert = FALSE, ...)
}
\arguments{
\item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.}
@@ -67,10 +71,15 @@
data(managers)
fit.macro <- fitTsfm(asset.names=colnames(managers[,(1:6)]),
factor.names=colnames(managers[,(7:8)]), data=managers)
-
ES.decomp <- fmEsDecomp(fit.macro)
# get the component contributions
ES.decomp$cES
+
+# Statistical Factor Model
+data(stat.fm.data)
+sfm.pca.fit <- fitSfm(sfm.dat, k=2)
+ES.decomp <- fmEsDecomp(sfm.pca.fit)
+ES.decomp$cES
}
\author{
Eric Zviot, Sangeetha Srinivasan and Yi-An Chen
Modified: pkg/FactorAnalytics/man/fmSdDecomp.Rd
===================================================================
--- pkg/FactorAnalytics/man/fmSdDecomp.Rd 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/man/fmSdDecomp.Rd 2014-11-25 23:37:06 UTC (rev 3563)
@@ -1,12 +1,15 @@
% Generated by roxygen2 (4.0.2): do not edit by hand
\name{fmSdDecomp}
\alias{fmSdDecomp}
+\alias{fmSdDecomp.sfm}
\alias{fmSdDecomp.tsfm}
\title{Decompose standard deviation into individual factor contributions}
\usage{
fmSdDecomp(object, ...)
\method{fmSdDecomp}{tsfm}(object, use = "pairwise.complete.obs", ...)
+
+\method{fmSdDecomp}{sfm}(object, use = "pairwise.complete.obs", ...)
}
\arguments{
\item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.}
@@ -53,10 +56,15 @@
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(stat.fm.data)
+sfm.pca.fit <- fitSfm(sfm.dat, k=2)
+decomp <- fmSdDecomp(sfm.pca.fit)
+decomp$pcSd
}
\author{
Eric Zivot, Sangeetha Srinivasan and Yi-An Chen
Modified: pkg/FactorAnalytics/man/fmVaRDecomp.Rd
===================================================================
--- pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2014-11-25 15:07:07 UTC (rev 3562)
+++ pkg/FactorAnalytics/man/fmVaRDecomp.Rd 2014-11-25 23:37:06 UTC (rev 3563)
@@ -1,6 +1,7 @@
% Generated by roxygen2 (4.0.2): do not edit by hand
\name{fmVaRDecomp}
\alias{fmVaRDecomp}
+\alias{fmVaRDecomp.sfm}
\alias{fmVaRDecomp.tsfm}
\title{Decompose VaR into individual factor contributions}
\usage{
@@ -8,6 +9,9 @@
\method{fmVaRDecomp}{tsfm}(object, p = 0.95, method = c("modified",
"gaussian", "historical", "kernel"), invert = FALSE, ...)
+
+\method{fmVaRDecomp}{sfm}(object, p = 0.95, method = c("modified",
+ "gaussian", "historical", "kernel"), invert = FALSE, ...)
}
\arguments{
\item{object}{fit object of class \code{tsfm}, \code{sfm} or \code{ffm}.}
@@ -69,6 +73,12 @@
VaR.decomp <- fmVaRDecomp(fit.macro)
# get the component contributions
VaR.decomp$cVaR
+
+# Statistical Factor Model
+data(stat.fm.data)
+sfm.pca.fit <- fitSfm(sfm.dat, k=2)
+VaR.decomp <- fmVaRDecomp(sfm.pca.fit)
+VaR.decomp$cVaR
}
\author{
Eric Zivot, Sangeetha Srinivasan and Yi-An Chen
Added: pkg/FactorAnalytics/man/predict.sfm.Rd
===================================================================
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3563
More information about the Returnanalytics-commits
mailing list