[Blotter-commits] r1699 - in pkg/quantstrat: R src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 23 05:05:47 CEST 2015
Author: bodanker
Date: 2015-09-23 05:05:45 +0200 (Wed, 23 Sep 2015)
New Revision: 1699
Modified:
pkg/quantstrat/R/signals.R
pkg/quantstrat/src/firstCross.c
Log:
Special case integer Data/threshold; support "!="
Instead of coercing all inputs to numeric, operate directly on integers
if both Data and threshold are integers (otherwise coerce to numeric).
Add support for "!=" (and "ne", "neq"), and add aliases "==", "<=", and
">=". Also add PACKAGE argument to .Call, to avoid repeated native
symbol lookups.
Modified: pkg/quantstrat/R/signals.R
===================================================================
--- pkg/quantstrat/R/signals.R 2015-08-23 23:00:31 UTC (rev 1698)
+++ pkg/quantstrat/R/signals.R 2015-09-23 03:05:45 UTC (rev 1699)
@@ -290,14 +290,20 @@
'gt' = 1,
'<' = ,
'lt' = 2,
- 'eq' = 3, #FIXME any way to specify '='?
+ '==' = ,
+ 'eq' = 3,
+ '>=' = ,
'gte' = ,
'gteq' = ,
- 'ge' = 4, #FIXME these fail with an 'unexpected =' error if you use '>='
+ 'ge' = 4,
+ '<=' = ,
'lte' = ,
'lteq' = ,
- 'le' = 5)
- .Call('firstCross', Data, threshold, rel, start)
+ 'le' = 5,
+ '!=' = ,
+ 'ne' = ,
+ 'neq' = 6)
+ .Call('firstCross', Data, threshold, rel, start, PACKAGE="quantstrat")
}
#' generate a signal from a formula
Modified: pkg/quantstrat/src/firstCross.c
===================================================================
--- pkg/quantstrat/src/firstCross.c 2015-08-23 23:00:31 UTC (rev 1698)
+++ pkg/quantstrat/src/firstCross.c 2015-09-23 03:05:45 UTC (rev 1699)
@@ -9,59 +9,118 @@
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 */
- PROTECT(x = coerceVector(x, REALSXP)); P++;
- real_th = asReal(th);
- int_rel = asInteger(rel);
- int_start = asInteger(start)-1;
-
/* return number of observations if relationship is never TRUE */
SEXP result = ScalarInteger(nrows(x));
- switch(int_rel) {
- case 1: /* > */
- real_x = REAL(x);
- for(i=int_start; i<nrows(x); i++)
- if(real_x[i] > real_th) {
- result = ScalarInteger(i+1);
- break;
- }
- break;
- case 2: /* < */
- real_x = REAL(x);
- for(i=int_start; i<nrows(x); i++)
- if(real_x[i] < real_th) {
- result = ScalarInteger(i+1);
- break;
- }
- break;
- case 3: /* == */
- real_x = REAL(x);
- for(i=int_start; i<nrows(x); i++)
- if(real_x[i] == real_th) {
- result = ScalarInteger(i+1);
- break;
- }
- break;
- case 4: /* >= */
- real_x = REAL(x);
- for(i=int_start; i<nrows(x); i++)
- if(real_x[i] >= real_th) {
- result = ScalarInteger(i+1);
- break;
- }
- break;
- case 5: /* <= */
- real_x = REAL(x);
- for(i=int_start; i<nrows(x); i++)
- if(real_x[i] <= real_th) {
- result = ScalarInteger(i+1);
- break;
- }
- break;
- default:
- error("unsupported relationship operator");
+ /* Use integers if both x and th are integers */
+ int *int_x=NULL, int_th;
+ if (TYPEOF(x) == INTSXP && TYPEOF(th) == INTSXP) {
+ int_x = INTEGER(x);
+ int_th = asInteger(th);
+ int_rel = asInteger(rel);
+ int_start = asInteger(start)-1;
+
+ switch(int_rel) {
+ case 1: /* > */
+ for(i=int_start; i<nrows(x); i++)
+ if(int_x[i] > int_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 2: /* < */
+ for(i=int_start; i<nrows(x); i++)
+ if(int_x[i] < int_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 3: /* == */
+ for(i=int_start; i<nrows(x); i++)
+ if(int_x[i] == int_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 4: /* >= */
+ for(i=int_start; i<nrows(x); i++)
+ if(int_x[i] >= int_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 5: /* <= */
+ for(i=int_start; i<nrows(x); i++)
+ if(int_x[i] <= int_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 6: /* != */
+ for(i=int_start; i<nrows(x); i++)
+ if(int_x[i] != int_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ default:
+ error("unsupported relationship operator");
+ }
+ } else {
+ /* this currently only works for real x and th arguments
+ * support for other types may be added later */
+ PROTECT(x = coerceVector(x, REALSXP)); P++;
+ real_x = REAL(x);
+ real_th = asReal(th);
+ int_rel = asInteger(rel);
+ int_start = asInteger(start)-1;
+
+ switch(int_rel) {
+ case 1: /* > */
+ for(i=int_start; i<nrows(x); i++)
+ if(real_x[i] > real_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 2: /* < */
+ for(i=int_start; i<nrows(x); i++)
+ if(real_x[i] < real_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 3: /* == */
+ for(i=int_start; i<nrows(x); i++)
+ if(real_x[i] == real_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 4: /* >= */
+ for(i=int_start; i<nrows(x); i++)
+ if(real_x[i] >= real_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 5: /* <= */
+ for(i=int_start; i<nrows(x); i++)
+ if(real_x[i] <= real_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ case 6: /* != */
+ for(i=int_start; i<nrows(x); i++)
+ if(real_x[i] != real_th) {
+ result = ScalarInteger(i+1);
+ break;
+ }
+ break;
+ default:
+ error("unsupported relationship operator");
+ }
}
UNPROTECT(P);
return(result);
More information about the Blotter-commits
mailing list