[Returnanalytics-commits] r2435 - pkg/FactorAnalytics/R

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

Author: chenyian
Date: 2013-06-25 23:57:59 +0200 (Tue, 25 Jun 2013)
New Revision: 2435

Modified:
   pkg/FactorAnalytics/R/fitStatisticalFactorModel.R
   pkg/FactorAnalytics/R/predict.StatFactorModel.r
Log:
create lm object for apca in  fitStatisticalFactorModel.R 

Modified: pkg/FactorAnalytics/R/fitStatisticalFactorModel.R
===================================================================
--- pkg/FactorAnalytics/R/fitStatisticalFactorModel.R	2013-06-25 20:22:57 UTC (rev 2434)
+++ pkg/FactorAnalytics/R/fitStatisticalFactorModel.R	2013-06-25 21:57:59 UTC (rev 2435)
@@ -84,11 +84,7 @@
 require(PerformanceAnalytics)
 
 
-# check data 
-data.xts <- checkData(data,method=ckeckData.method) 
-data <- coredata(data.xts)
 
-
   
  # function of test
  mfactor.test <- function(data, method = "bn", refine = TRUE, check = FALSE, max.k = NULL, sig = 0.05){
@@ -306,13 +302,45 @@
 	dimnames(B) <- list(paste("F", 1:k, sep = "."), data.names)
 	dimnames(f) <- list(dimnames(data)[[1]], paste("F", 1:k, sep = "."))
 	names(alpha) <- data.names
-	res <- t(t(data) - alpha) - f %*% B
+	resid <- t(t(data) - alpha) - f %*% B
 	r2 <- (1 - colSums(res^2)/colSums(xc^2))
+  
+  if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) {
+    f <- xts(f,index(data.xts))
+    resid <- xts(resid,index(data.xts))
+  }
+  
+  # create lm list for plot
+  reg.list = list()
+  if (ckeckData.method == "xts" | ckeckData.method == "zoo" ) {
+    for (i in data.names) {
+      reg.xts = merge(data.xts[,i],f)
+      colnames(reg.xts)[1] <- i
+      fm.formula = as.formula(paste(i,"~", ".", sep=" "))
+      fm.fit = lm(fm.formula, data=reg.xts)
+      reg.list[[i]] = fm.fit
+    }
+  } else {
+    for (i in data.names) {
+      reg.df = as.data.frame(cbind(data[,i],coredata(f)))
+      colnames(reg.df)[1] <- i
+      fm.formula = as.formula(paste(i,"~", ".", sep=" "))
+      fm.fit = lm(fm.formula, data=reg.df)
+      reg.list[[i]] = fm.fit
+    }
+  }
+  
+  
   ans <- 	list(factors = f, loadings = B, k = k, alpha = alpha, ret.cov = ret.cov,
-		           r2 = r2, eigen = eig.tmp$values, residuals=res,asset.ret = data)
+		           r2 = r2, eigen = eig.tmp$values, residuals=resid,asset.ret = data,
+               asset.fit=reg.list)
  return(ans)
 }
 
+# check data 
+data.xts <- checkData(data,method=ckeckData.method) 
+data <- coredata(data.xts)
+
   call <- match.call()  
   pos <- rownames(data)
 	data <- as.matrix(data)

Modified: pkg/FactorAnalytics/R/predict.StatFactorModel.r
===================================================================
--- pkg/FactorAnalytics/R/predict.StatFactorModel.r	2013-06-25 20:22:57 UTC (rev 2434)
+++ pkg/FactorAnalytics/R/predict.StatFactorModel.r	2013-06-25 21:57:59 UTC (rev 2435)
@@ -18,6 +18,7 @@
 #' @export
 #' 
 
+
 predict.StatFactorModel <- function(fit,...){
   lapply(fit$asset.fit, predict,...)
 }
\ No newline at end of file