[Blotter-commits] r1572 - in pkg/quantstrat: R src

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

Author: bodanker
Date: 2013-11-13 21:58:15 +0100 (Wed, 13 Nov 2013)
New Revision: 1572

Removed:
   pkg/quantstrat/src/firstThreshold.c
Modified:
   pkg/quantstrat/R/rules.R
Log:
- rename .firstThreshold to .firstCross
- r1564 fix accidentally removed
- delete src/firstThreshold.c


Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R	2013-11-13 20:19:57 UTC (rev 1571)
+++ pkg/quantstrat/R/rules.R	2013-11-13 20:58:15 UTC (rev 1572)
@@ -641,7 +641,15 @@
         if(!isTRUE(rule$enabled)) next()
         
         # check to see if we should run in this timespan
-        if(!is.null(rule$timespan) && nrow(mktdata[curIndex][rule$timespan])==0) next()
+        if(!is.null(rule$timespan)) {
+            # Get row index of timestamp for faster subsetting
+            if(hasArg(curIndex))
+                curIndex <- eval(match.call(expand.dots=TRUE)$curIndex, parent.frame())
+            else
+                curIndex <- timestamp
+            if(nrow(mktdata[curIndex][rule$timespan])==0)
+                next()
+        }
         
         # modify a few things
         rule$arguments$timestamp = timestamp

Deleted: pkg/quantstrat/src/firstThreshold.c
===================================================================
--- pkg/quantstrat/src/firstThreshold.c	2013-11-13 20:19:57 UTC (rev 1571)
+++ pkg/quantstrat/src/firstThreshold.c	2013-11-13 20:58:15 UTC (rev 1572)
@@ -1,55 +0,0 @@
-#include <R.h>
-#include <Rinternals.h>
-
-SEXP firstThreshold(SEXP x, SEXP th, SEXP rel, SEXP start)
-{
-    int i, int_rel, int_start;
-    double *real_x=NULL, real_th;
-
-    if(ncols(x) > 1)
-        error("only univariate data allowed");
-
-    /* this currently only works for real x and th arguments
-     * support for other types may be added later */
-    real_th = asReal(th);
-    int_rel = asInteger(rel);
-    int_start = asInteger(start)-1;
-
-    switch(int_rel) {
-        case 1:  /* >  */
-            real_x = REAL(x);
-            for(i=int_start; i<nrows(x); i++)
-                if(real_x[i] >  real_th)
-                    return(ScalarInteger(i+1));
-            break;
-        case 2:  /* <  */
-            real_x = REAL(x);
-            for(i=int_start; i<nrows(x); i++)
-                if(real_x[i] <  real_th)
-                    return(ScalarInteger(i+1));
-            break;
-        case 3:  /* == */
-            real_x = REAL(x);
-            for(i=int_start; i<nrows(x); i++)
-                if(real_x[i] == real_th)
-                    return(ScalarInteger(i+1));
-            break;
-        case 4:  /* >= */
-            real_x = REAL(x);
-            for(i=int_start; i<nrows(x); i++)
-                if(real_x[i] >= real_th)
-                    return(ScalarInteger(i+1));
-            break;
-        case 5:  /* <= */
-            real_x = REAL(x);
-            for(i=int_start; i<nrows(x); i++)
-                if(real_x[i] <= real_th)
-                    return(ScalarInteger(i+1));
-            break;
-        default:
-            error("unsupported relationship operator");
-  }
-  /* return number of observations if relationship is never TRUE */
-  return(ScalarInteger(nrows(x)));
-}
-