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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Nov 12 20:49:53 CET 2012


Author: peter_carl
Date: 2012-11-12 20:49:53 +0100 (Mon, 12 Nov 2012)
New Revision: 2298

Modified:
   pkg/PerformanceAnalytics/R/SystematicRisk.R
Log:
- added multiple benchmark handling
- replaced calc with existing StdDev.annualized function


Modified: pkg/PerformanceAnalytics/R/SystematicRisk.R
===================================================================
--- pkg/PerformanceAnalytics/R/SystematicRisk.R	2012-11-12 19:16:20 UTC (rev 2297)
+++ pkg/PerformanceAnalytics/R/SystematicRisk.R	2012-11-12 19:49:53 UTC (rev 2298)
@@ -15,6 +15,8 @@
 #' asset returns
 #' @param Rb return vector of the benchmark asset 
 #' @param Rf risk free rate, in same period as your returns
+#' @param scale number of periods in a year (daily scale = 252, monthly scale =
+#' 12, quarterly scale = 4)
 #' @param \dots any other passthru parameters
 #' @author Matthieu Lestel
 #' @references Carl Bacon, \emph{Practical portfolio performance measurement 
@@ -32,37 +34,50 @@
 #'
 #' @export 
 SystematicRisk <-
-function (Ra, Rb, Rf = 0, ...)
+function (Ra, Rb, Rf = 0, scale = NA, ...)
 {
-    calcul = FALSE
-    Ra = checkData(Ra, method="matrix")
-    Rb = checkData(Rb, method="matrix")
-
-    if (ncol(Ra)==1 || is.null(Ra) || is.vector(Ra)) {
-    
-     for (i in (1:length(Ra))) {
-     	 if (!is.na(Ra[i])) {
-     	    calcul = TRUE
-	 }
-      }
-
-     if (calcul) {
-     	Period = Frequency(Ra)
-        result = CAPM.beta(Ra,Rb,Rf) * sqrt(sum((Rb-mean(Rb))^2)/length(Rb))*sqrt(Period)
-     }    
-     else {
-        result = NA
-     }
+  # FUNCTION:
+  Ra = checkData(Ra)
+  Rb = checkData(Rb)
+  if(!is.null(dim(Rf)))
+    Rf = checkData(Rf)
+  
+  if(is.na(scale)) {
+    freq = periodicity(Ra)
+    switch(freq$scale,
+           minute = {stop("Data periodicity too high")},
+           hourly = {stop("Data periodicity too high")},
+           daily = {scale = 252},
+           weekly = {scale = 52},
+           monthly = {scale = 12},
+           quarterly = {scale = 4},
+           yearly = {scale = 1}
+    )
+  }
+  
+  Ra.ncols = NCOL(Ra) 
+  Rb.ncols = NCOL(Rb)
+  
+  xRa = Return.excess(Ra, Rf)
+  xRb = Return.excess(Rb, Rf)
+  
+  pairs = expand.grid(1:Ra.ncols, 1:Rb.ncols)
+  
+  sr <- function(xRa, xRb, scale){
+      result = CAPM.beta(xRa, xRb) * StdDev.annualized(xRb, scale=scale)
       return(result)
-    }
-    else {
-        Ra = checkData(Ra)
-        result = apply(Ra, MARGIN = 2, SystematicRisk, Rb = Rb, Rf = Rf, ...)
-        result<-t(result)
-        colnames(result) = colnames(Ra)
-        rownames(result) = paste("Systematic Risk (Risk free = ",Rf,")", sep="")
-        return(result)
-    }
+  }
+  
+  result = apply(pairs, 1, FUN = function(n, xRa, xRb, scale) sr(xRa[,n[1]], xRb[,n[2]], scale), xRa = xRa, xRb = xRb, scale=scale)
+  
+  if(length(result) ==1)
+    return(result)
+  else {
+    dim(result) = c(Ra.ncols, Rb.ncols)
+    colnames(result) = paste("Systematic Risk to ", colnames(Rb), " (Rf = ",Rf,")", sep="")
+    rownames(result) = colnames(Ra)
+    return(t(result))
+  }
 }
 
 



More information about the Returnanalytics-commits mailing list