SCM

SCM Repository

[blotter] View of /pkg/quantstrat/src/firstCross.c
ViewVC logotype

View of /pkg/quantstrat/src/firstCross.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1699 - (download) (as text) (annotate)
Wed Sep 23 03:05:45 2015 UTC (3 years, 5 months ago) by bodanker
File size: 4272 byte(s)
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.
#include <R.h>
#include <Rinternals.h>

SEXP firstCross(SEXP x, SEXP th, SEXP rel, SEXP start)
{
    int i, int_rel, int_start, P=0;
    double *real_x=NULL, real_th;

    if(ncols(x) > 1)
        error("only univariate data allowed");

    /* return number of observations if relationship is never TRUE */
    SEXP result = ScalarInteger(nrows(x));

    /* 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);
}


R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge