[Returnanalytics-commits] r2303 - pkg/PerformanceAnalytics/R

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

Author: bodanker
Date: 2012-12-15 20:02:01 +0100 (Sat, 15 Dec 2012)
New Revision: 2303

Modified:
   pkg/PerformanceAnalytics/R/CAPM.beta.R
Log:
- update CAPM.beta* to be more robust to NAs


Modified: pkg/PerformanceAnalytics/R/CAPM.beta.R
===================================================================
--- pkg/PerformanceAnalytics/R/CAPM.beta.R	2012-12-14 20:40:52 UTC (rev 2302)
+++ pkg/PerformanceAnalytics/R/CAPM.beta.R	2012-12-15 19:02:01 UTC (rev 2303)
@@ -111,16 +111,9 @@
 
     pairs = expand.grid(1:Ra.ncols, 1:Rb.ncols)
 
-    beta <-function (xRa, xRb)
-    {
-        merged = as.data.frame(na.omit(cbind(xRa, xRb)))
-        model.lm = lm(merged[,1] ~ merged[,2], merged)
-        beta = coef(model.lm)[[2]]
-        beta
-    }
+    result = apply(pairs, 1, FUN = function(n, xRa, xRb)
+        .beta(xRa[,n[1]], xRb[,n[2]]), xRa = xRa, xRb = xRb)
 
-    result = apply(pairs, 1, FUN = function(n, xRa, xRb) beta(xRa[,n[1]], xRb[,n[2]]), xRa = xRa, xRb = xRb)
-
     if(length(result) ==1)
         return(result)
     else {
@@ -163,18 +156,9 @@
 
     pairs = expand.grid(1:Ra.ncols, 1:Rb.ncols)
 
-    beta <-function (xRa, xRb)
-    {
-        merged = na.omit(cbind(xRa, xRb))
-        merged = as.data.frame(merged)
-        colnames(merged) = c("xRa","xRb")
-        model.lm = lm(xRa ~ xRb, merged, subset= (xRb > 0))
-        beta = coef(model.lm)[[2]]
-        beta
-    }
+    result = apply(pairs, 1, FUN = function(n, xRa, xRb)
+        .beta(xRa[,n[1]], xRb[,n[2]], xRb[,n[2]] > 0), xRa = xRa, xRb = xRb)
 
-    result = apply(pairs, 1, FUN = function(n, xRa, xRb) beta(xRa[,n[1]], xRb[,n[2]]), xRa = xRa, xRb = xRb)
-
     if(length(result) ==1)
         return(result)
     else {
@@ -217,18 +201,9 @@
 
     pairs = expand.grid(1:Ra.ncols, 1:Rb.ncols)
 
-    beta <-function (xRa, xRb)
-    {
-        merged = na.omit(cbind(xRa, xRb))
-        merged = as.data.frame(merged)
-        colnames(merged) = c("xRa","xRb")
-        model.lm = lm(xRa ~ xRb, merged, subset= (xRb < 0))
-        beta = coef(model.lm)[[2]]
-        beta
-    }
+    result = apply(pairs, 1, FUN = function(n, xRa, xRb)
+        .beta(xRa[,n[1]], xRb[,n[2]], xRb[,n[2]] < 0), xRa = xRa, xRb = xRb)
 
-    result = apply(pairs, 1, FUN = function(n, xRa, xRb) beta(xRa[,n[1]], xRb[,n[2]]), xRa = xRa, xRb = xRb)
-
     if(length(result) ==1)
         return(result)
     else {
@@ -261,6 +236,26 @@
         return(result)
     }
 }
+
+.beta <- function (xRa, xRb, subset) {
+    # subset is assumed to be a logical vector
+    if(missing(subset))
+        subset <- TRUE
+    # check columns
+    if(NCOL(xRa)!=1L || NCOL(xRb)!=1L || NCOL(subset)!=1L)
+        stop("all arguments must have only one column")
+    # merge, drop NA, add column names
+    merged <- as.data.frame(na.omit(cbind(xRa, xRb, subset)))
+    colnames(merged) <- c("xRa","xRb","subset")
+    merged$subset <- as.logical(merged$subset)
+    # return NA if no non-NA values
+    if(NROW(merged)==0)
+        return(NA)
+    # calculate beta
+    model.lm = lm(xRa ~ xRb, data=merged, subset=merged$subset)
+    beta = coef(model.lm)[[2]]
+    beta
+}
 ###############################################################################
 # R (http://r-project.org/) Econometrics for Performance and Risk Analysis
 #