[Returnanalytics-commits] r3543 - pkg/PerformanceAnalytics/sandbox

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

Author: peter_carl
Date: 2014-10-15 13:27:35 +0200 (Wed, 15 Oct 2014)
New Revision: 3543

Modified:
   pkg/PerformanceAnalytics/sandbox/to.period.contributions.R
Log:
- added check for periodicity
- added reclass for result
- added copyright block
- added to.*.contributions functions as wrappers

Modified: pkg/PerformanceAnalytics/sandbox/to.period.contributions.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/to.period.contributions.R	2014-10-15 03:02:05 UTC (rev 3542)
+++ pkg/PerformanceAnalytics/sandbox/to.period.contributions.R	2014-10-15 11:27:35 UTC (rev 3543)
@@ -1,7 +1,22 @@
-to.period.contributions <- function(C, period = c("years", "quarters", "months", "weeks"), ...){
+to.period.contributions <- function(Contributions, period = c("years", "quarters", "months", "weeks"), ...){
+  C = checkData(Contributions)
   period = period[1] 
   columnnames = colnames(C)
-  # @TODO make sure period > frequency of C
+  if(!xtsible(Contributions))
+    stop("'Contributions' needs to be timeBased or xtsible." )
+  # Make sure period > frequency of C
+  err=FALSE
+  freq = periodicity(C)
+  switch(freq$scale,
+      minute = {stop("Data periodicity too high")},
+      hourly = {stop("Data periodicity too high")},
+      daily = {ifelse(!period %in% c("years", "quarters", "months", "weeks"), err <- TRUE,NA)},
+      weekly = {ifelse(!period %in% c("years", "quarters", "months"), err <- TRUE,NA)},
+      monthly = {ifelse(!period %in% c("years", "quarters"), err <- TRUE,NA)},
+      quarterly = {ifelse(!period %in% c("years"), err <- TRUE,NA)},
+      yearly = {stop("Data periodicity too low")}
+  )
+  if(err) stop("Period specified is higher than data periodicity.  Specify a lower frequency instead.")
   
   # Calculate period return of portfolio from contributions
   pret = rowSums(C)
@@ -30,5 +45,33 @@
   period.contrib = as.xts(period.contrib, order.by = dates)
   period.contrib = cbind(period.contrib, rowSums(period.contrib))
   colnames(period.contrib) = c(columnnames, "Portfolio Return")
+  period.contrib = reclass(period.contrib, x)
+
   return(period.contrib)
-}
\ No newline at end of file
+  
+}
+
+to.weekly.contributions <- function(contributions) {
+  to.period.contributions(contributions = contributions, period = "weeks")
+}
+to.monthly.contributions <- function(contributions) {
+  to.period.contributions(contributions = contributions, period = "months")
+}
+to.quarterly.contributions <- function(contributions) {
+  to.period.contributions(contributions = contributions, period = "quarters")
+}
+to.yearly.contributions <- function(contributions) {
+  to.period.contributions(contributions = contributions, period = "years")
+}
+
+###############################################################################
+# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
+#
+# Copyright (c) 2004-2014 Peter Carl and Brian G. Peterson
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: $
+#
+###############################################################################
\ No newline at end of file