[Returnanalytics-commits] r2700 - in pkg/FactorAnalytics: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 2 20:01:50 CEST 2013
Author: chenyian
Date: 2013-08-02 20:01:50 +0200 (Fri, 02 Aug 2013)
New Revision: 2700
Modified:
pkg/FactorAnalytics/NAMESPACE
pkg/FactorAnalytics/R/factorModelMonteCarlo.R
pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R
pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r
pkg/FactorAnalytics/R/plot.StatFactorModel.r
pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r
pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r
pkg/FactorAnalytics/R/predict.StatFactorModel.r
pkg/FactorAnalytics/R/predict.TimeSeriesFactorModel.r
pkg/FactorAnalytics/R/print.FundamentalFactorModel.r
pkg/FactorAnalytics/R/print.StatFactorModel.r
pkg/FactorAnalytics/R/print.TimeSeriesFactorModel.r
pkg/FactorAnalytics/R/summary.FundamentalFactorModel.r
pkg/FactorAnalytics/R/summary.StatFactorModel.r
pkg/FactorAnalytics/R/summary.TimeSeriesFactorModel.r
pkg/FactorAnalytics/man/plot.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/plot.StatFactorModel.Rd
pkg/FactorAnalytics/man/plot.TimeSeriesFactorModel.Rd
pkg/FactorAnalytics/man/predict.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/predict.StatFactorModel.Rd
pkg/FactorAnalytics/man/predict.TimeSeriesFactorModel.Rd
pkg/FactorAnalytics/man/print.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/print.StatFactorModel.Rd
pkg/FactorAnalytics/man/print.TimeSeriesFactorModel.Rd
pkg/FactorAnalytics/man/summary.FundamentalFactorModel.Rd
pkg/FactorAnalytics/man/summary.StatFactorModel.Rd
pkg/FactorAnalytics/man/summary.TimeSeriesFactorModel.Rd
Log:
debug generic related function .Rd files.
Modified: pkg/FactorAnalytics/NAMESPACE
===================================================================
--- pkg/FactorAnalytics/NAMESPACE 2013-08-02 12:15:36 UTC (rev 2699)
+++ pkg/FactorAnalytics/NAMESPACE 2013-08-02 18:01:50 UTC (rev 2700)
@@ -0,0 +1,14 @@
+export(factorModelMonteCarlo)
+export(fitTimeSeriesFactorModel)
+S3method(plot,FundamentalFactorModel)
+S3method(plot,StatFactorModel)
+S3method(plot,TimeSeriesFactorModel)
+S3method(predict,FundamentalFactorModel)
+S3method(predict,StatFactorModel)
+S3method(print,FundamentalFactorModel)
+S3method(print,StatFactorModel)
+S3method(print,TimeSeriesFactorModel)
+S3method(summary,FundamentalFactorModel)
+S3method(summary,StatFactorModel)
+S3method(summary,TimeSeriesFactorModel)
+S3method(TimeSeriesFactorModel)
Modified: pkg/FactorAnalytics/R/factorModelMonteCarlo.R
===================================================================
--- pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2013-08-02 12:15:36 UTC (rev 2699)
+++ pkg/FactorAnalytics/R/factorModelMonteCarlo.R 2013-08-02 18:01:50 UTC (rev 2700)
@@ -44,6 +44,7 @@
#' residuals. Returned only if \code{return.residuals = TRUE}.
#' @author Eric Zivot and Yi-An Chen.
#' @references Jiang, Y. (2009). UW PhD Thesis.
+#' @export
#' @examples
#'
#' # load data from the database
Modified: pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2013-08-02 12:15:36 UTC (rev 2699)
+++ pkg/FactorAnalytics/R/fitTimeSeriesFactorModel.R 2013-08-02 18:01:50 UTC (rev 2700)
@@ -84,6 +84,7 @@
#' chart.TimeSeries(dataToPlot, main="FM fit for HAM1",
#' colorset=c("black","blue"), legend.loc="bottomleft")
#' }
+#' @export
fitTimeSeriesFactorModel <-
function(assets.names, factors.names, data=data, num.factor.subset = 1,
fit.method=c("OLS","DLS","Robust"),
Modified: pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-08-02 12:15:36 UTC (rev 2699)
+++ pkg/FactorAnalytics/R/plot.FundamentalFactorModel.r 2013-08-02 18:01:50 UTC (rev 2700)
@@ -9,7 +9,7 @@
#' Generic function of plot method for fitFundamentalFactorModel.
#'
#'
-#' @param fit.fund fit object created by fitFundamentalFactorModel.
+#' @param x fit object created by fitFundamentalFactorModel.
#' @param which.plot integer indicating which plot to create: "none" will
#' create a menu to choose. Defualt is none.
#' 1 = "Factor returns",
@@ -55,9 +55,11 @@
#'
#' plot(fit.fund)
#' }
+#' @method plot FundamentalFactorModel
+#' @export
#'
plot.FundamentalFactorModel <-
-function(fit.fund,which.plot=c("none","1L","2L","3L","4L","5L","6L"),max.show=4,
+function(x,which.plot=c("none","1L","2L","3L","4L","5L","6L"),max.show=4,
plot.single=FALSE, asset.name,
which.plot.single=c("none","1L","2L","3L","4L","5L","6L",
"7L","8L","9L"),legend.txt=TRUE,...)
@@ -67,14 +69,14 @@
if (plot.single == TRUE) {
- idx <- fit.fund$data[,fit.fund$assetvar] == asset.name
- asset.ret <- fit.fund$data[idx,fit.fund$returnsvar]
- dates <- fit.fund$data[idx,fit.fund$datevar]
+ idx <- x$data[,x$assetvar] == asset.name
+ asset.ret <- x$data[idx,x$returnsvar]
+ dates <- x$data[idx,x$datevar]
actual.z <- zoo(asset.ret,as.Date(dates))
- residuals.z <- zoo(fit.fund$residuals[,asset.name],as.Date(dates))
+ residuals.z <- zoo(x$residuals[,asset.name],as.Date(dates))
fitted.z <- actual.z - residuals.z
t <- length(dates)
- k <- length(fit.fund$exposure.names)
+ k <- length(x$exposure.names)
which.plot.single<-menu(c("time series plot of actual and fitted values",
"time series plot of residuals with standard error bands",
@@ -155,7 +157,7 @@
"Factor Contributions to VaR"),
title="Factor Analytics Plot \nMake a plot selection (or 0 to exit):\n")
- n <- length(fit.fund$asset.names)
+ n <- length(x$asset.names)
if (n >= max.show) {
cat(paste("numbers of assets are greater than",max.show,", show only first",
max.show,"assets",sep=" "))
@@ -164,42 +166,42 @@
switch(which.plot,
"1L" = {
- factor.names <- colnames(fit.fund$factor.returns)
+ factor.names <- colnames(x$factor.returns)
# nn <- length(factor.names)
par(mfrow=c(n,1))
options(show.error.messages=FALSE)
for (i in factor.names[1:n]) {
- plot(fit.fund$factor.returns[,i],main=paste(i," Factor Returns",sep="") )
+ plot(x$factor.returns[,i],main=paste(i," Factor Returns",sep="") )
}
par(mfrow=c(1,1))
},
"2L" ={
par(mfrow=c(n,1))
- names <- colnames(fit.fund$residuals[,1:n])
+ names <- colnames(x$residuals[,1:n])
for (i in names) {
- plot(fit.fund$residuals[,i],main=paste(i," Residuals", sep=""))
+ plot(x$residuals[,i],main=paste(i," Residuals", sep=""))
}
par(mfrow=c(1,1))
},
"3L" = {
- barplot(fit.fund$resid.variance[c(1:n)],...)
+ barplot(x$resid.variance[c(1:n)],...)
},
"4L" = {
- cor.fm = cov2cor(fit.fund$returns.cov$cov)
+ cor.fm = cov2cor(x$returns.cov$cov)
rownames(cor.fm) = colnames(cor.fm)
ord <- order(cor.fm[1,])
ordered.cor.fm <- cor.fm[ord, ord]
plotcorr(ordered.cor.fm[c(1:n),c(1:n)], col=cm.colors(11)[5*ordered.cor.fm + 6])
},
"5L" = {
- cov.factors = var(fit.fund$factor.returns)
- names = fit.fund$asset.names
+ cov.factors = var(x$factor.returns)
+ names = x$asset.names
factor.sd.decomp.list = list()
for (i in names) {
factor.sd.decomp.list[[i]] =
- factorModelSdDecomposition(fit.fund$beta[i,],
- cov.factors, fit.fund$resid.variance[i])
+ factorModelSdDecomposition(x$beta[i,],
+ cov.factors, x$resid.variance[i])
}
# function to efit.stattract contribution to sd from list
getCSD = function(x) {
@@ -207,7 +209,7 @@
}
# extract contributions to SD from list
cr.sd = sapply(factor.sd.decomp.list, getCSD)
- rownames(cr.sd) = c(colnames(fit.fund$factor.returns), "residual")
+ rownames(cr.sd) = c(colnames(x$factor.returns), "residual")
# create stacked barchart
# discard intercept
barplot(cr.sd[-1,(1:max.show)], main="Factor Contributions to SD",
@@ -215,19 +217,19 @@
} ,
"6L" = {
factor.es.decomp.list = list()
- names = fit.fund$asset.names
+ names = x$asset.names
for (i in names) {
# check for missing values in fund data
-# idx = which(!is.na(fit.fund$data[,i]))
- idx <- fit.fund$data[,fit.fund$assetvar] == i
- asset.ret <- fit.fund$data[idx,fit.fund$returnsvar]
- tmpData = cbind(asset.ret, fit.fund$factor.returns,
- fit.fund$residuals[,i]/sqrt(fit.fund$resid.variance[i]) )
+# idx = which(!is.na(x$data[,i]))
+ idx <- x$data[,x$assetvar] == i
+ asset.ret <- x$data[idx,x$returnsvar]
+ tmpData = cbind(asset.ret, x$factor.returns,
+ x$residuals[,i]/sqrt(x$resid.variance[i]) )
colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual")
factor.es.decomp.list[[i]] =
factorModelEsDecomposition(tmpData,
- fit.fund$beta[i,],
- fit.fund$resid.variance[i], tail.prob=0.05)
+ x$beta[i,],
+ x$resid.variance[i], tail.prob=0.05)
}
# stacked bar charts of percent contributions to ES
@@ -236,25 +238,25 @@
}
# report as positive number
cr.etl = sapply(factor.es.decomp.list, getCETL)
- rownames(cr.etl) = c(colnames(fit.fund$factor.returns), "residual")
+ rownames(cr.etl) = c(colnames(x$factor.returns), "residual")
barplot(cr.etl[-1,(1:max.show)], main="Factor Contributions to ES",
legend.text=legend.txt, args.legend=list(x="topleft"),...)
},
"7L" = {
factor.VaR.decomp.list = list()
- names = fit.fund$asset.names
+ names = x$asset.names
for (i in names) {
# check for missing values in fund data
- # idx = which(!is.na(fit.fund$data[,i]))
- idx <- fit.fund$data[,fit.fund$assetvar] == i
- asset.ret <- fit.fund$data[idx,fit.fund$returnsvar]
- tmpData = cbind(asset.ret, fit.fund$factor.returns,
- fit.fund$residuals[,i]/sqrt(fit.fund$resid.variance[i]) )
+ # idx = which(!is.na(x$data[,i]))
+ idx <- x$data[,x$assetvar] == i
+ asset.ret <- x$data[idx,x$returnsvar]
+ tmpData = cbind(asset.ret, x$factor.returns,
+ x$residuals[,i]/sqrt(x$resid.variance[i]) )
colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual")
factor.VaR.decomp.list[[i]] =
factorModelVaRDecomposition(tmpData,
- fit.fund$beta[i,],
- fit.fund$resid.variance[i], tail.prob=0.05)
+ x$beta[i,],
+ x$resid.variance[i], tail.prob=0.05)
}
@@ -264,7 +266,7 @@
}
# report as positive number
cr.var = sapply(factor.VaR.decomp.list, getCVaR)
- rownames(cr.var) = c(colnames(fit.fund$factor.returns), "residual")
+ rownames(cr.var) = c(colnames(x$factor.returns), "residual")
barplot(cr.var[-1,(1:max.show)], main="Factor Contributions to VaR",
legend.text=legend.txt, args.legend=list(x="topleft"),...)
},
@@ -273,6 +275,5 @@
}
-
}
Modified: pkg/FactorAnalytics/R/plot.StatFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/plot.StatFactorModel.r 2013-08-02 12:15:36 UTC (rev 2699)
+++ pkg/FactorAnalytics/R/plot.StatFactorModel.r 2013-08-02 18:01:50 UTC (rev 2700)
@@ -5,7 +5,7 @@
#'
#' PCA works well. APCA is underconstruction.
#'
-#' @param fit.stat fit object created by fitStatisticalFactorModel.
+#' @param x fit object created by fitStatisticalFactorModel.
#' @param variables Optional. an integer vector telling which variables are to
#' be plotted. The default is to plot all the variables, or the number of
#' variables explaining 90 percent of the variance, whichever is bigger.
@@ -50,9 +50,10 @@
#' # plot single asset
#' plot(sfm.pca.fit,plot.single=TRUE,asset.name="CITCRP")
#' }
-#'
+#' @method plot StatFactorModel
+#' @export
plot.StatFactorModel <-
-function(fit.stat, variables, cumulative = TRUE, style = "bar",
+function(x, variables, cumulative = TRUE, style = "bar",
which.plot = c("none","1L","2L","3L","4L","5L","6L","7L","8L"),
hgrid = FALSE, vgrid = FALSE,plot.single=FALSE, asset.name,
which.plot.single=c("none","1L","2L","3L","4L","5L","6L",
@@ -130,10 +131,10 @@
# pca method
- if ( dim(fit.stat$asset.ret)[1] > dim(fit.stat$asset.ret)[2] ) {
+ if ( dim(x$asset.ret)[1] > dim(x$asset.ret)[2] ) {
- fit.lm = fit.stat$asset.fit[[asset.name]]
+ fit.lm = x$asset.fit[[asset.name]]
## exact information from lm object
@@ -248,12 +249,12 @@
)
} else { #apca method
- dates <- names(fit.stat$data[,asset.name])
- actual.z <- zoo(fit.stat$asset.ret[,asset.name],as.Date(dates))
- residuals.z <- zoo(fit.stat$residuals,as.Date(dates))
+ dates <- names(x$data[,asset.name])
+ actual.z <- zoo(x$asset.ret[,asset.name],as.Date(dates))
+ residuals.z <- zoo(x$residuals,as.Date(dates))
fitted.z <- actual.z - residuals.z
t <- length(dates)
- k <- fit.stat$k
+ k <- x$k
which.plot.single<-menu(c("time series plot of actual and fitted values",
"time series plot of residuals with standard error bands",
@@ -346,12 +347,12 @@
## 1. screeplot.
##
if(missing(variables)) {
- vars <- fit.stat$eigen
+ vars <- x$eigen
n90 <- which(cumsum(vars)/
sum(vars) > 0.9)[1]
- variables <- 1:max(fit.stat$k, min(10, n90))
+ variables <- 1:max(x$k, min(10, n90))
}
- screeplot(fit.stat, variables, cumulative,
+ screeplot(x, variables, cumulative,
style, "Screeplot")
},
"2L" = {
@@ -359,14 +360,14 @@
## 2. factor returns
##
if(missing(variables)) {
- f.ret <- fit.stat$factors
+ f.ret <- x$factors
}
plot.ts(f.ret)
} ,
"3L" = {
- cov.fm<- factorModelCovariance(t(fit.stat$loadings),var(fit.stat$factors),
- fit.stat$resid.variance)
+ cov.fm<- factorModelCovariance(t(x$loadings),var(x$factors),
+ x$resid.variance)
cor.fm = cov2cor(cov.fm)
rownames(cor.fm) = colnames(cor.fm)
ord <- order(cor.fm[1,])
@@ -374,44 +375,44 @@
plotcorr(ordered.cor.fm[(1:max.show),(1:max.show)], col=cm.colors(11)[5*ordered.cor.fm + 6])
},
"4L" ={
- barplot(fit.stat$r2[1:max.show])
+ barplot(x$r2[1:max.show])
},
"5L" = {
- barplot(fit.stat$resid.variance[1:max.show])
+ barplot(x$resid.variance[1:max.show])
},
"6L" = {
- cov.factors = var(fit.stat$factors)
- names = colnames(fit.stat$asset.ret)
+ cov.factors = var(x$factors)
+ names = colnames(x$asset.ret)
factor.sd.decomp.list = list()
for (i in names) {
factor.sd.decomp.list[[i]] =
- factorModelSdDecomposition(fit.stat$loadings[,i],
- cov.factors, fit.stat$resid.variance[i])
+ factorModelSdDecomposition(x$loadings[,i],
+ cov.factors, x$resid.variance[i])
}
- # function to efit.stattract contribution to sd from list
+ # function to extract contribution to sd from list
getCSD = function(x) {
x$cr.fm
}
# extract contributions to SD from list
cr.sd = sapply(factor.sd.decomp.list, getCSD)
- rownames(cr.sd) = c(colnames(fit.stat$factors), "residual")
+ rownames(cr.sd) = c(colnames(x$factors), "residual")
# create stacked barchart
barplot(cr.sd[,(1:max.show)], main="Factor Contributions to SD",
legend.text=T, args.legend=list(x="topleft"))
} ,
"7L" ={
factor.es.decomp.list = list()
- names = colnames(fit.stat$asset.ret)
+ names = colnames(x$asset.ret)
for (i in names) {
# check for missing values in fund data
- idx = which(!is.na(fit.stat$asset.ret[,i]))
- tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors,
- fit.stat$residuals[,i]/sqrt(fit.stat$resid.variance[i]))
+ idx = which(!is.na(x$asset.ret[,i]))
+ tmpData = cbind(x$asset.ret[idx,i], x$factors,
+ x$residuals[,i]/sqrt(x$resid.variance[i]))
colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual")
factor.es.decomp.list[[i]] =
factorModelEsDecomposition(tmpData,
- fit.stat$loadings[,i],
- fit.stat$resid.variance[i], tail.prob=0.05)
+ x$loadings[,i],
+ x$resid.variance[i], tail.prob=0.05)
}
@@ -421,23 +422,23 @@
}
# report as positive number
cr.etl = sapply(factor.es.decomp.list, getCETL)
- rownames(cr.etl) = c(colnames(fit.stat$factors), "residual")
+ rownames(cr.etl) = c(colnames(x$factors), "residual")
barplot(cr.etl[,(1:max.show)], main="Factor Contributions to ES",
legend.text=T, args.legend=list(x="topleft") )
},
"8L" = {
factor.VaR.decomp.list = list()
- names = colnames(fit.stat$asset.ret)
+ names = colnames(x$asset.ret)
for (i in names) {
# check for missing values in fund data
- idx = which(!is.na(fit.stat$asset.ret[,i]))
- tmpData = cbind(fit.stat$asset.ret[idx,i], fit.stat$factors,
- fit.stat$residuals[,i]/sqrt(fit.stat$resid.variance[i]))
+ idx = which(!is.na(x$asset.ret[,i]))
+ tmpData = cbind(x$asset.ret[idx,i], x$factors,
+ x$residuals[,i]/sqrt(x$resid.variance[i]))
colnames(tmpData)[c(1,length(tmpData[1,]))] = c(i, "residual")
factor.VaR.decomp.list[[i]] =
factorModelVaRDecomposition(tmpData,
- fit.stat$loadings[,i],
- fit.stat$resid.variance[i], tail.prob=0.05)
+ x$loadings[,i],
+ x$resid.variance[i], tail.prob=0.05)
}
@@ -447,7 +448,7 @@
}
# report as positive number
cr.var = sapply(factor.VaR.decomp.list, getCVaR)
- rownames(cr.var) = c(colnames(fit.stat$factors), "residual")
+ rownames(cr.var) = c(colnames(x$factors), "residual")
barplot(cr.var[,(1:max.show)], main="Factor Contributions to VaR",
legend.text=T, args.legend=list(x="topleft"))
}, invisible()
@@ -455,4 +456,5 @@
)
}
+
}
Modified: pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2013-08-02 12:15:36 UTC (rev 2699)
+++ pkg/FactorAnalytics/R/plot.TimeSeriesFactorModel.r 2013-08-02 18:01:50 UTC (rev 2700)
@@ -4,7 +4,7 @@
#' all fit models or choose a single asset to plot.
#'
#'
-#' @param fit.macro fit object created by fitTimeSeriesFactorModel.
+#' @param x fit object created by fitTimeSeriesFactorModel.
#' @param colorset Defualt colorset is c(1:12).
#' @param legend.loc plot legend or not. Defualt is \code{NULL}.
#' @param which.plot integer indicating which plot to create: "none" will
@@ -39,9 +39,10 @@
#' # single plot of HAM1 asset
#' plot(fit.macro, plot.single=TRUE, asset.name="HAM1")
#' }
-#'
+#' @method plot TimeSeriesFactorModel
+#' @export
plot.TimeSeriesFactorModel <-
- function(fit.macro,colorset=c(1:12),legend.loc=NULL,
+ function(x,colorset=c(1:12),legend.loc=NULL,
which.plot=c("none","1L","2L","3L","4L","5L","6L","7L"),max.show=6,
plot.single=FALSE, asset.name,which.plot.single=c("none","1L","2L","3L","4L","5L","6L",
"7L","8L","9L","10L","11L","12L","13L")) {
@@ -75,9 +76,9 @@
stop("Neet to specify an asset to plot if plot.single is TRUE.")
}
- fit.lm = fit.macro$asset.fit[[asset.name]]
+ fit.lm = x$asset.fit[[asset.name]]
- if (fit.macro$variable.selection == "none") {
+ if (x$variable.selection == "none") {
## extract information from lm object
@@ -156,7 +157,7 @@
},
"10L"= {
## CUSUM plot of recursive residuals
- if (as.character(fit.macro$call["fit.method"]) == "OLS") {
+ if (as.character(x$call["fit.method"]) == "OLS") {
cusum.rec = efp(fit.formula, type="Rec-CUSUM", data=fit.lm$model)
plot(cusum.rec, sub=asset.name)
} else
@@ -164,7 +165,7 @@
},
"11L"= {
## CUSUM plot of OLS residuals
- if (as.character(fit.macro$call["fit.method"]) == "OLS") {
+ if (as.character(x$call["fit.method"]) == "OLS") {
cusum.ols = efp(fit.formula, type="OLS-CUSUM", data=fit.lm$model)
plot(cusum.ols, sub=asset.name)
} else
@@ -172,7 +173,7 @@
},
"12L"= {
## CUSUM plot of recursive estimates relative to full sample estimates
- if (as.character(fit.macro$call["fit.method"]) == "OLS") {
+ if (as.character(x$call["fit.method"]) == "OLS") {
cusum.est = efp(fit.formula, type="fluctuation", data=fit.lm$model)
plot(cusum.est, functional=NULL, sub=asset.name)
} else
@@ -180,7 +181,7 @@
},
"13L"= {
## rolling regression over 24 month window
- if (as.character(fit.macro$call["fit.method"]) == "OLS") {
+ if (as.character(x$call["fit.method"]) == "OLS") {
rollReg <- function(data.z, formula) {
coef(lm(formula, data = as.data.frame(data.z)))
}
@@ -188,8 +189,8 @@
rollReg.z = rollapply(reg.z, FUN=rollReg, fit.formula, width=24, by.column = FALSE,
align="right")
plot(rollReg.z, main=paste("24-month rolling regression estimates:", asset.name, sep=" "))
- } else if (as.character(fit.macro$call["fit.method"]) == "DLS") {
- decay.factor <- as.numeric(as.character(fit.macro$call["decay.factor"]))
+ } else if (as.character(x$call["fit.method"]) == "DLS") {
+ decay.factor <- as.numeric(as.character(x$call["decay.factor"]))
t.length <- 24
w <- rep(decay.factor^(t.length-1),t.length)
for (k in 2:t.length) {
@@ -213,10 +214,10 @@
} else {
# lar or lasso
- factor.names = fit.macro$factors.names
- plot.data = fit.macro$data[,c(asset.name,factor.names)]
- alpha = fit.macro$alpha[asset.name]
- beta = as.matrix(fit.macro$beta[asset.name,])
+ factor.names = x$factors.names
+ plot.data = x$data[,c(asset.name,factor.names)]
+ alpha = x$alpha[asset.name]
+ beta = as.matrix(x$beta[asset.name,])
fitted.z = zoo(alpha+as.matrix(plot.data[,factor.names])%*%beta,as.Date(rownames(plot.data)))
residuals.z = plot.data[,asset.name]-fitted.z
actual.z = zoo(plot.data[,asset.name],as.Date(rownames(plot.data)))
@@ -303,10 +304,10 @@
title="Factor Analytics Plot \nMake a plot selection (or 0 to exit):\n")
- variable.selection = fit.macro$variable.selection
- asset.names = fit.macro$assets.names
- factor.names = fit.macro$factors.names
- plot.data = fit.macro$data[,c(asset.names,factor.names)]
+ variable.selection = x$variable.selection
+ asset.names = x$assets.names
+ factor.names = x$factors.names
+ plot.data = x$data[,c(asset.names,factor.names)]
cov.factors = var(plot.data[,factor.names])
n <- length(asset.names)
@@ -321,8 +322,8 @@
par(mfrow=c(n/2,2))
if (variable.selection == "lar" || variable.selection == "lasso") {
for (i in 1:n) {
- alpha = fit.macro$alpha[i]
- beta = as.matrix(fit.macro$beta[i,])
+ alpha = x$alpha[i]
+ beta = as.matrix(x$beta[i,])
fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta
dataToPlot = cbind(fitted, plot.data[,i])
colnames(dataToPlot) = c("Fitted","Actual")
@@ -331,7 +332,7 @@
}
} else {
for (i in 1:n) {
- dataToPlot = cbind(fitted(fit.macro$asset.fit[[i]]), na.omit(plot.data[,i]))
+ dataToPlot = cbind(fitted(x$asset.fit[[i]]), na.omit(plot.data[,i]))
colnames(dataToPlot) = c("Fitted","Actual")
main = paste("Factor Model fit for",asset.names[i],seq="")
chart.TimeSeries(dataToPlot,colorset = colorset, legend.loc = legend.loc,main=main)
@@ -340,14 +341,14 @@
par(mfrow=c(1,1))
},
"2L" ={
- barplot(fit.macro$r2)
+ barplot(x$r2)
},
"3L" = {
- barplot(fit.macro$resid.variance)
+ barplot(x$resid.variance)
},
"4L" = {
- cov.fm<- factorModelCovariance(fit.macro$beta,cov.factors,fit.macro$resid.variance)
+ cov.fm<- factorModelCovariance(x$beta,cov.factors,x$resid.variance)
cor.fm = cov2cor(cov.fm)
rownames(cor.fm) = colnames(cor.fm)
ord <- order(cor.fm[1,])
@@ -358,8 +359,8 @@
factor.sd.decomp.list = list()
for (i in asset.names) {
factor.sd.decomp.list[[i]] =
- factorModelSdDecomposition(fit.macro$beta[i,],
- cov.factors, fit.macro$resid.variance[i])
+ factorModelSdDecomposition(x$beta[i,],
+ cov.factors, x$resid.variance[i])
}
# function to extract contribution to sd from list
getCSD = function(x) {
@@ -379,17 +380,17 @@
for (i in asset.names) {
idx = which(!is.na(plot.data[,i]))
- alpha = fit.macro$alpha[i]
- beta = as.matrix(fit.macro$beta[i,])
+ alpha = x$alpha[i]
+ beta = as.matrix(x$beta[i,])
fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta
residual = plot.data[,i]-fitted
tmpData = cbind(plot.data[idx,i], plot.data[idx,factor.names],
- (residual[idx,]/sqrt(fit.macro$resid.variance[i])) )
+ (residual[idx,]/sqrt(x$resid.variance[i])) )
colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual")
factor.es.decomp.list[[i]] =
factorModelEsDecomposition(tmpData,
- fit.macro$beta[i,],
- fit.macro$resid.variance[i], tail.prob=0.05)
+ x$beta[i,],
+ x$resid.variance[i], tail.prob=0.05)
}
} else {
@@ -398,12 +399,12 @@
# check for missing values in fund data
idx = which(!is.na(plot.data[,i]))
tmpData = cbind(plot.data[idx,i], plot.data[idx,factor.names],
- residuals(fit.macro$asset.fit[[i]])/sqrt(fit.macro$resid.variance[i]))
+ residuals(x$asset.fit[[i]])/sqrt(x$resid.variance[i]))
colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual")
factor.es.decomp.list[[i]] =
factorModelEsDecomposition(tmpData,
- fit.macro$beta[i,],
- fit.macro$resid.variance[i], tail.prob=0.05)
+ x$beta[i,],
+ x$resid.variance[i], tail.prob=0.05)
}
}
@@ -425,17 +426,17 @@
for (i in asset.names) {
idx = which(!is.na(plot.data[,i]))
- alpha = fit.macro$alpha[i]
- beta = as.matrix(fit.macro$beta[i,])
+ alpha = x$alpha[i]
+ beta = as.matrix(x$beta[i,])
fitted = alpha+as.matrix(plot.data[,factor.names])%*%beta
residual = plot.data[,i]-fitted
tmpData = cbind(plot.data[idx,i], plot.data[idx,factor.names],
- (residual[idx,]/sqrt(fit.macro$resid.variance[i])) )
+ (residual[idx,]/sqrt(x$resid.variance[i])) )
colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual")
factor.VaR.decomp.list[[i]] =
factorModelVaRDecomposition(tmpData,
- fit.macro$beta[i,],
- fit.macro$resid.variance[i], tail.prob=0.05)
+ x$beta[i,],
+ x$resid.variance[i], tail.prob=0.05)
}
} else {
@@ -443,12 +444,12 @@
# check for missing values in fund data
idx = which(!is.na(plot.data[,i]))
tmpData = cbind(plot.data[idx,i], plot.data[idx,factor.names],
- residuals(fit.macro$asset.fit[[i]])/sqrt(fit.macro$resid.variance[i]))
+ residuals(x$asset.fit[[i]])/sqrt(x$resid.variance[i]))
colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual")
factor.VaR.decomp.list[[i]] =
factorModelVaRDecomposition(tmpData,
- fit.macro$beta[i,],
- fit.macro$resid.variance[i], tail.prob=0.05,
+ x$beta[i,],
+ x$resid.variance[i], tail.prob=0.05,
VaR.method="HS")
}
}
@@ -466,5 +467,5 @@
invisible()
)
}
-
+
}
Modified: pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r 2013-08-02 12:15:36 UTC (rev 2699)
+++ pkg/FactorAnalytics/R/predict.FundamentalFactorModel.r 2013-08-02 18:01:50 UTC (rev 2700)
@@ -5,35 +5,36 @@
#' newdata must be data.frame and contians date variable, asset variable and exact
#' exposures names that are used in fit object by \code{fitFundamentalFactorModel}
#'
-#' @param fit "FundamentalFactorModel" object
+#' @param object fit "FundamentalFactorModel" object
#' @param newdata An optional data frame in which to look for variables with which to predict.
#' If omitted, the fitted values are used.
#' @param new.assetvar specify new asset variable in newdata if newdata is provided.
-#' @param new.datevar speficy new date variable in newdata if newdata is provided.
+#' @param new.datevar speficy new date variable in newdata if newdata is provided.
+#' @method predict FundamentalFactorModel
#' @export
#' @author Yi-An Chen
#'
-predict.FundamentalFactorModel <- function(fit.fund,newdata,new.assetvar,new.datevar){
+predict.FundamentalFactorModel <- function(object,newdata,new.assetvar,new.datevar){
# if there is no newdata provided
# calculate fitted values
- datevar <- as.character(fit.fund$datevar)
- assetvar <- as.character(fit.fund$assetvar)
- assets = unique(fit.fund$data[,assetvar])
- timedates = as.Date(unique(fit.fund$data[,datevar]))
- exposure.names <- fit.fund$exposure.names
+ datevar <- as.character(object$datevar)
+ assetvar <- as.character(object$assetvar)
+ assets = unique(object$data[,assetvar])
+ timedates = as.Date(unique(object$data[,datevar]))
+ exposure.names <- object$exposure.names
numTimePoints <- length(timedates)
numExposures <- length(exposure.names)
numAssets <- length(assets)
- f <- fit.fund$factor.returns # T X 3
+ f <- object$factor.returns # T X 3
predictor <- function(data) {
fitted <- rep(NA,numAssets)
for (i in 1:numTimePoints) {
- fit.tmp <- fit.fund$beta %*% t(f[i,])
+ fit.tmp <- object$beta %*% t(f[i,])
fitted <- rbind(fitted,t(fit.tmp))
}
fitted <- fitted[-1,]
@@ -63,7 +64,7 @@
}
if (missing(newdata) || is.null(newdata)) {
- ans <- predictor(fit.fund$data)
+ ans <- predictor(object$data)
}
# predict returns by newdata
@@ -82,6 +83,5 @@
ans <- predictor.new(newdata,new.datevar,new.assetvar)
}
}
-
return(ans)
}
\ No newline at end of file
Modified: pkg/FactorAnalytics/R/predict.StatFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/predict.StatFactorModel.r 2013-08-02 12:15:36 UTC (rev 2699)
+++ pkg/FactorAnalytics/R/predict.StatFactorModel.r 2013-08-02 18:01:50 UTC (rev 2700)
@@ -3,7 +3,7 @@
#' Generic function of predict method for fitStatisticalFactorModel. It utilizes
#' function \code{predict.lm}.
#'
-#' @param fit.stat "StatFactorModel" object created by fitStatisticalFactorModel.
+#' @param object A fit object created by fitStatisticalFactorModel.
#' @param newdata a vector, matrix, data.frame, xts, timeSeries or zoo object to be coerced.
#' @param ... Any other arguments used in \code{predict.lm}. For example like newdata and fit.se.
#' @author Yi-An Chen.
@@ -14,16 +14,17 @@
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 2700
More information about the Returnanalytics-commits
mailing list