[Blotter-commits] r592 - pkg/FinancialInstrument/R

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

Author: braverock
Date: 2011-04-09 20:03:21 +0200 (Sat, 09 Apr 2011)
New Revision: 592

Added:
   pkg/FinancialInstrument/R/splice.R
   pkg/FinancialInstrument/R/splooth.R
Log:
- commit Robert Sams' splice and splooth, not exported

Added: pkg/FinancialInstrument/R/splice.R
===================================================================
--- pkg/FinancialInstrument/R/splice.R	                        (rev 0)
+++ pkg/FinancialInstrument/R/splice.R	2011-04-09 18:03:21 UTC (rev 592)
@@ -0,0 +1,36 @@
+splice <- function(x, at){
+  if(is.zoo(x))
+    return(xts(splice(coredata(x), at), order.by=index(x)))
+  x <- as.matrix(x)
+  if((nrow(x) %% length(at)) != 0)
+    stop("length(at) must be a multiple of nrow(x)")
+  at <- as.logical(try(cbind(at, 1:nrow(x))[, 1]))
+  if(!any(at))
+    return(x)
+  w <- which(at)
+  n <- max(length(w) - ncol(x) + 1, 1) 
+  y <- matrix(NA, nrow=nrow(x), ncol=n)
+  for(j in 1:n){
+    if(n == j)
+      rows <- seq(w[j], nrow(x))
+    else
+      rows <- seq(w[j], w[j + ncol(x)] - 1)
+    cols <- cumsum(at[rows])
+    y[rows, j] <- sapply(1:length(rows), function(i){x[rows[i], cols[i]]})
+  }
+  y
+}
+
+# this function originally copyright and written by Robert Sams robert at sanctumfi.com 
+###############################################################################
+# R (http://r-project.org/) Instrument Class Model
+#
+# Copyright (c) 2009-2011
+# Peter Carl, Dirk Eddelbuettel, Jeffrey Ryan, Joshua Ulrich and Brian G. Peterson
+#
+# This library is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: instrument.R 384 2010-09-03 13:06:31Z braverock $
+#
+###############################################################################
\ No newline at end of file

Added: pkg/FinancialInstrument/R/splooth.R
===================================================================
--- pkg/FinancialInstrument/R/splooth.R	                        (rev 0)
+++ pkg/FinancialInstrument/R/splooth.R	2011-04-09 18:03:21 UTC (rev 592)
@@ -0,0 +1,57 @@
+splooth <- function(x, at, method=c("diff","ratio","wavg")){
+  if(is.zoo(x))
+    return(xts(splooth(coredata(x), at, method), order.by=index(x)))
+  method <- method[1]
+  at <- cbind(at, x)[, 1]
+  at <- as.logical(at)
+  if(!is.matrix(x))
+    stop("x must be a matrix.")
+  if(ncol(x) < 2)
+    stop("x must have at least two columns")
+  if(any(n <- is.na(x[which(at), ])))
+    stop(paste("x[at, ] cannot have any NA's\n see:", paste(which(n), collapse=",")))
+  for(i in 1:(ncol(x) - 1)){
+    if(method == "diff"){
+      adj <- rep(0, nrow(x))
+      adj[at] <- x[at, i] - x[at, i + 1]
+      y <- x[, i] - rev(cumsum(rev(adj)))
+    }else if(method == "ratio"){
+      if(any(x <= 0))
+        stop("All x values must be positive if method='ratio'")
+      adj <- rep(1, nrow(x))
+      adj[at] <- x[at, i] / x[at, i + 1]
+      y <- x[, i] * rev(cumprod(rev(adj)))
+    }else if(method == "wavg"){
+      w <- c(which(at), length(at) + 1)
+      tim <- 1:length(at)
+      nxt <- w[c(1, (cumsum(at) + 1)[-length(at)])]
+      lst <- c(0, cumsum(at)[-length(at)])
+      lst[lst != 0] <- w[lst[lst != 0]]
+      y <- x[, i] * ((nxt - tim) / (nxt - lst)) + x[, i + 1] * ((tim - lst) / (nxt - lst))
+    }else{
+      stop("method must be 'diff', 'ratio', or 'wavg'")
+    }
+    if(i == 1)
+      z <- y
+    else
+      z <- cbind(z, y)
+  }
+  z <- cbind(z, x[, ncol(x)])
+  colnames(z) <- colnames(x)
+  rownames(z) <- rownames(x)
+  z
+}
+
+# this function originally copyright and written by Robert Sams robert at sanctumfi.com 
+###############################################################################
+# R (http://r-project.org/) Instrument Class Model
+#
+# Copyright (c) 2009-2011
+# Peter Carl, Dirk Eddelbuettel, Jeffrey Ryan, Joshua Ulrich and Brian G. Peterson
+#
+# This library is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: instrument.R 384 2010-09-03 13:06:31Z braverock $
+#
+###############################################################################
\ No newline at end of file