[Returnanalytics-commits] r2975 - in pkg/FactorAnalytics: . R

[noreply at r-forge.r-project.org]

Author: chenyian
Date: 2013-09-03 22:16:33 +0200 (Tue, 03 Sep 2013)
New Revision: 2975

Added:
   pkg/FactorAnalytics/R/summary.FM.attribution.r
Modified:
   pkg/FactorAnalytics/NAMESPACE
   pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r
Log:
add function summary.FM.attribution.r

Modified: pkg/FactorAnalytics/NAMESPACE
===================================================================
--- pkg/FactorAnalytics/NAMESPACE	2013-09-03 17:22:58 UTC (rev 2974)
+++ pkg/FactorAnalytics/NAMESPACE	2013-09-03 20:16:33 UTC (rev 2975)
@@ -1,3 +1,4 @@
+S3method(summary.FM.attribution)
 export(factorModelPerformanceAttribution)
 export(dCornishFisher)
 export(factorModelCovariance)

Modified: pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r
===================================================================
--- pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r	2013-09-03 17:22:58 UTC (rev 2974)
+++ pkg/FactorAnalytics/R/factorModelPerformanceAttribution.r	2013-09-03 20:16:33 UTC (rev 2975)
@@ -86,42 +86,42 @@
     fundName = rownames(fit$beta)
     
     attr.list <- list()
-  #  data <- checkData(fit$data)
+    #  data <- checkData(fit$data)
     for (k in fundName) {
-    fit.lm = fit$asset.fit[[k]]
-   
-    ## extract information from lm object
-    date <- rownames(fit.lm$model[1])
-   
-    actual.xts = xts(fit.lm$model[1], as.Date(date))
- 
-
-# attributed returns
-# active portfolio management p.512 17A.9 
+      fit.lm = fit$asset.fit[[k]]
+      
+      ## extract information from lm object
+      date <- rownames(fit.lm$model[1])
+      
+      actual.xts = xts(fit.lm$model[1], as.Date(date))
+      
+      
+      # attributed returns
+      # active portfolio management p.512 17A.9 
+      
+      cum.ret <-   Return.cumulative(actual.xts)
+      # setup initial value
+      attr.ret.xts.all <- xts(, as.Date(date))
+      for ( i in factorName ) {
+        
+        if (is.na(fit$beta[k,i])) {
+          cum.attr.ret[k,i] <- NA
+          attr.ret.xts.all <- merge(attr.ret.xts.all,xts(rep(NA,length(date)),as.Date(date)))  
+        } else {
+          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 - Return.cumulative(actual.xts-attr.ret.xts)  
+          attr.ret.xts.all <- merge(attr.ret.xts.all,attr.ret.xts)
+        }
+      }
     
-  cum.ret <-   Return.cumulative(actual.xts)
-  # setup initial value
-  attr.ret.xts.all <- xts(, as.Date(date))
-  for ( i in factorName ) {
-  
-    if (fit$beta[k,i]==0) {
-    cum.attr.ret[k,i] <- 0
-  attr.ret.xts.all <- merge(attr.ret.xts.all,xts(rep(0,length(date)),as.Date(date)))  
-  } else {
-  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 - Return.cumulative(actual.xts-attr.ret.xts)  
-  attr.ret.xts.all <- merge(attr.ret.xts.all,attr.ret.xts)
-  }
-  
-  }
-    
-  # specific returns    
-    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)
-  attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts)
-   colnames(attr.list[[k]]) <- c(factorName,"specific.returns")
+      
+      # specific returns    
+      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)
+      attr.list[[k]] <- merge(attr.ret.xts.all,spec.ret.xts)
+      colnames(attr.list[[k]]) <- c(factorName,"specific.returns")
     }
 
     

Added: pkg/FactorAnalytics/R/summary.FM.attribution.r
===================================================================
--- pkg/FactorAnalytics/R/summary.FM.attribution.r	                        (rev 0)
+++ pkg/FactorAnalytics/R/summary.FM.attribution.r	2013-09-03 20:16:33 UTC (rev 2975)
@@ -0,0 +1,32 @@
+#' summary FM.attribution object.
+#' 
+#' Generic function of summary method for factorModelPerformanceAttribution.
+#' 
+#' 
+#' @param fm.attr FM.attribution object created by
+#' factorModelPerformanceAttribution.
+#' @author Yi-An Chen.
+#' @examples
+#' # load data from the database
+#'  data(managers.df)
+#'  # fit the factor model with OLS
+#'  fit.ts <- fitTimeSeriesFactorModel(assets.names=colnames(managers.df[,(1:6)]),
+#'                                factors.names=c("EDHEC.LS.EQ","SP500.TR"),
+#'                                data=managers.df,fit.method="OLS")
+#'   
+#'   fm.attr <- factorModelPerformanceAttribution(fit.ts)
+#'   summary(fm.attr)
+#' @method summary FM.attribution  
+#' @export   
+#' 
+summary.FM.attribution <- function(fm.attr) {
+#   n <- dim(fm.attr[[1]])[1]
+#   k <- dim(fm.attr[[1]])[2]+1 
+# table.mat <- matrix(rep(NA,n*k*2),ncol=n)
+  cat("\nMean of returns attributed to factors
+      \n")
+  print(sapply(fm.attr[[3]],function(x) apply(x,2,mean)))
+  cat("\nStandard Deviation of returns attributed to factors
+      \n")
+  print(sapply(fm.attr[[3]],function(x) apply(x,2,sd)))  
+}