[Returnanalytics-commits] r2118 - pkg/FactorAnalytics/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jul 7 06:49:23 CEST 2012
Author: chenyian
Date: 2012-07-07 06:49:23 +0200 (Sat, 07 Jul 2012)
New Revision: 2118
Added:
pkg/FactorAnalytics/R/factorModelAttribution.r
pkg/FactorAnalytics/R/plot.MacroFactorModel.r
pkg/FactorAnalytics/R/print.MacroFactorModel.r
pkg/FactorAnalytics/R/summary.MacroFactorModel.r
Modified:
pkg/FactorAnalytics/R/fitMacroeconomicFactorModel.R
Log:
Added: pkg/FactorAnalytics/R/factorModelAttribution.r
===================================================================
--- pkg/FactorAnalytics/R/factorModelAttribution.r (rev 0)
+++ pkg/FactorAnalytics/R/factorModelAttribution.r 2012-07-07 04:49:23 UTC (rev 2118)
@@ -0,0 +1,34 @@
+# Yi-An Chen
+# July 5, 2012
+
+factorModelAttribution <-
+ function(fit) {
+ class = class(fit,benchmark)
+ # input
+ # class: Class has to be either MacroFactorModel, FundmentalFactorModel
+ # or StatFactorModel
+ # benchmark: benchmark returns, default is
+ # only class of 3 fit model can be used
+ if (class !="MacroFactorModel" && class !="FundmentalFactorModel"
+ && class != "StatFactorModel")
+ {
+ stop("Class has to be either MacroFactorModel, FundmentalFactorModel
+ or StatFactorModel")
+ }
+
+
+ # beginning of switching
+ switch(class,
+ MacroFactorModel={
+
+
+ },
+ FundmentalFactorModel={
+ print("test 2")
+ },
+ StatFactorModel={
+
+ }
+
+ )
+ }
\ No newline at end of file
Modified: pkg/FactorAnalytics/R/fitMacroeconomicFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitMacroeconomicFactorModel.R 2012-07-06 22:47:10 UTC (rev 2117)
+++ pkg/FactorAnalytics/R/fitMacroeconomicFactorModel.R 2012-07-07 04:49:23 UTC (rev 2118)
@@ -284,8 +284,12 @@
beta.mat = Betas,
r2.vec = R2values,
residVars.vec = ResidVars,
- call = this.call
+ call = this.call,
+ ret.assets = ret.assets,
+ factors = factors,
+ variable.selection = variable.selection
)
+class(ans) = "MacroFactorModel"
return(ans)
}
Added: pkg/FactorAnalytics/R/plot.MacroFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/plot.MacroFactorModel.r (rev 0)
+++ pkg/FactorAnalytics/R/plot.MacroFactorModel.r 2012-07-07 04:49:23 UTC (rev 2118)
@@ -0,0 +1,131 @@
+plot.MacroFactorModel <-
+ function(fit.macro,colorset=c(1:12),legend.loc=NULL,which=c("none","1L","2L","3L",
+ "4L","5L")) {
+ which<-which[1]
+
+ if(which=='none')
+ which<-menu(c("Fitted factor returns","FM Correlation",
+ "Factor Contributions to SD",
+ "Factor Contributions to ES",
+ "Factor Contributions to VaR"),
+ title="Factor Analytics Plot")
+
+ variable.selection = fit.macro$variable.selection
+ manager.names = colnames(fit.macro$ret.assets)
+ factor.names = colnames(fit.macro$factors)
+ managers.df = cbind(ret.assets,factors)
+ cov.factors = var(fit.macro$factors)
+ n <- length(manager.names)
+
+
+ switch(which,"1L" = {
+
+ par(mfrow=c(n/2,2))
+ if (variable.selection == "lar" || variable.selection == "lasso") {
+ for (i in 1:n) {
+ alpha = fit.macro$alpha.vec[i]
+ beta = as.matrix(fit.macro$beta.mat[i,])
+ fitted = alpha+as.matrix(fit.macro$factors)%*%beta
+ dataToPlot = cbind(fitted, na.omit(fit.macro$ret.assets[,i]))
+ colnames(dataToPlot) = c("Fitted","Actual")
+ main = paste("Factor Model fit for",manager.names[i],seq="")
+ chart.TimeSeries(dataToPlot,colorset = colorset, legend.loc = legend.loc,main=main)
+ }
+ } else {
+ for (i in 1:n) {
+ dataToPlot = cbind(fitted(fit.macro$asset.fit[[i]]), na.omit(fit.macro$ret.assets[,i]))
+ colnames(dataToPlot) = c("Fitted","Actual")
+ main = paste("Factor Model fit for",manager.names[i],seq="")
+ chart.TimeSeries(dataToPlot,colorset = colorset, legend.loc = legend.loc,main=main)
+ }
+ }
+ par(mfrow=c(1,1))
+ },
+
+ "2L" = {
+ cov.fm<- factorModelCovariance(fit.macro$beta.mat,var(fit.macro$factors),fit.macro$residVars.vec)
+ cor.fm = cov2cor(cov.fm)
+ rownames(cor.fm) = colnames(cor.fm)
+ ord <- order(cor.fm[1,])
+ ordered.cor.fm <- cor.fm[ord, ord]
+ plotcorr(ordered.cor.fm, col=cm.colors(11)[5*ordered.cor.fm + 6])
+ },
+ "3L" = {
+ factor.sd.decomp.list = list()
+ for (i in manager.names) {
+ factor.sd.decomp.list[[i]] =
+ factorModelSdDecomposition(fit.macro$beta.mat[i,],
+ cov.factors, fit.macro$residVars.vec[i])
+ }
+ # 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(factor.names, "residual")
+ # create stacked barchart
+ barplot(cr.sd, main="Factor Contributions to SD",
+ legend.text=T, args.legend=list(x="topleft"),
+ col=c(1:50) )
+
+ },
+ "4L"={
+
+ factor.es.decomp.list = list()
+ for (i in manager.names) {
+ # check for missing values in fund data
+ idx = which(!is.na(managers.df[,i]))
+ tmpData = cbind(managers.df[idx,i], managers.df[idx,factor.names],
+ residuals(fit.macro$asset.fit[[i]])/sqrt(fit.macro$residVars.vec[i]))
+ colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual")
+ factor.es.decomp.list[[i]] =
+ factorModelEsDecomposition(tmpData,
+ fit.macro$beta.mat[i,],
+ fit.macro$residVars.vec[i], tail.prob=0.05)
+ }
+
+
+ # stacked bar charts of percent contributions to SD
+ getCETL = function(x) {
+ x$cES
+ }
+ # report as positive number
+ cr.etl = sapply(factor.es.decomp.list, getCETL)
+ rownames(cr.etl) = c(factor.names, "residual")
+ barplot(cr.etl, main="Factor Contributions to ES",
+ legend.text=T, args.legend=list(x="topleft"),
+ col=c(1:50) )
+ },
+ "5L" ={
+
+ factor.VaR.decomp.list = list()
+ for (i in manager.names) {
+ # check for missing values in fund data
+ idx = which(!is.na(managers.df[,i]))
+ tmpData = cbind(managers.df[idx,i], managers.df[idx,factor.names],
+ residuals(fit.macro$asset.fit[[i]])/sqrt(fit.macro$residVars.vec[i]))
+ colnames(tmpData)[c(1,length(tmpData))] = c(i, "residual")
+ factor.VaR.decomp.list[[i]] =
+ factorModelVaRDecomposition(tmpData,
+ fit.macro$beta.mat[i,],
+ fit.macro$residVars.vec[i], tail.prob=0.05,
+ VaR.method="HS")
+ }
+
+
+ # stacked bar charts of percent contributions to SD
+ getCVaR = function(x) {
+ x$cVaR.fm
+ }
+ # report as positive number
+ cr.VaR = sapply(factor.VaR.decomp.list, getCVaR)
+ rownames(cr.VaR) = c(factor.names, "residual")
+ barplot(cr.VaR, main="Factor Contributions to VaR",
+ legend.text=T, args.legend=list(x="topleft"),
+ col=c(1:50) )
+ }
+ )
+
+
+}
\ No newline at end of file
Added: pkg/FactorAnalytics/R/print.MacroFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/print.MacroFactorModel.r (rev 0)
+++ pkg/FactorAnalytics/R/print.MacroFactorModel.r 2012-07-07 04:49:23 UTC (rev 2118)
@@ -0,0 +1,4 @@
+print.MacroFactorModel <-
+ function(fit.macro) {
+ lapply(fit.macro[[1]], print)
+ }
\ No newline at end of file
Added: pkg/FactorAnalytics/R/summary.MacroFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/summary.MacroFactorModel.r (rev 0)
+++ pkg/FactorAnalytics/R/summary.MacroFactorModel.r 2012-07-07 04:49:23 UTC (rev 2118)
@@ -0,0 +1,5 @@
+summary.MacroFactorModel <-
+ function(fit.macro){
+ lapply(fit.macro[[1]], summary)
+ }
+
\ No newline at end of file
More information about the Returnanalytics-commits
mailing list