- Fixed bug in EMA when n < NROW(x), thanks to Douglas Hobbs

- Converted C++ style comments to C style git-svn-id: svn+ssh://svn.r-forge.r-project.org/svnroot/ttr/pkg@97 edb9625f-4e0d-4859-8d74-9fd3b1da38cb
jgehw · Feb 26, 2010 · 2a9e215 · 2a9e215
1 parent 6bcd73e
commit 2a9e215
Show file tree

Hide file tree

Showing 5 changed files with 77 additions and 85 deletions.
diff --git a/R/MovingAverages.R b/R/MovingAverages.R
@@ -45,7 +45,9 @@ function (x, n=10, wilder=FALSE, ratio=NULL) {
   # http://stockcharts.com/education/IndicatorAnalysis/indic_movingAvg.html
 
   x <- try.xts(x, error=as.matrix)
-
+  if( n < 1 || n > NROW(x) )
+    stop("Invalid 'n'")
+
   # Check for non-leading NAs
   # Leading NAs are handled in the C code
   x.na <- xts:::naCheck(x, n)

diff --git a/src/adjRatios.c b/src/adjRatios.c
@@ -1,5 +1,4 @@
 /*
- *
  *  TTR: Technical Trading Rules
  *
  *  Copyright (C) 2007-2010  Joshua M. Ulrich
@@ -23,51 +22,51 @@
 
 SEXP adjRatios (SEXP split, SEXP div, SEXP close) {
 
-    // Initialize REAL pointers to function arguments
+    /* Initialize REAL pointers to function arguments */
     double *real_close = REAL(close);
     double *real_split = REAL(split);
     double *real_div   = REAL(div);
 
-    // Initalize loop and PROTECT counters
+    /* Initalize loop and PROTECT counters */
     int i, P = 0;
-    // Initalize object length (NOTE: all arguments are the same length)
+    /* Initalize object length (NOTE: all arguments are the same length) */
     int N = length(close);
 
-    // Initalize result R objects
+    /* Initalize result R objects */
     SEXP result;    PROTECT(result  = allocVector(VECSXP, 2)); P++;
     SEXP s_ratio;   PROTECT(s_ratio = allocVector(REALSXP,N)); P++;
     SEXP d_ratio;   PROTECT(d_ratio = allocVector(REALSXP,N)); P++;
 
-    // Initialize REAL pointers to R objects and set their last value to '1'
+    /* Initialize REAL pointers to R objects and set their last value to '1' */
     double *rs_ratio = REAL(s_ratio);
     double *rd_ratio = REAL(d_ratio);
     rs_ratio[N-1] = 1;
     rd_ratio[N-1] = 1;
 
-    // Loop over split/div vectors from newest period to oldest
+    /* Loop over split/div vectors from newest period to oldest */
     for(i = N-1; i > 0; i--) {
-        // Carry newer ratio value backward
+        /* Carry newer ratio value backward */
         if(ISNA(real_split[i])) {
             rs_ratio[i-1] = rs_ratio[i];
-        // Update split ratio
+        /* Update split ratio */
         } else {
             rs_ratio[i-1] = rs_ratio[i] * real_split[i];
         }
-        // Carry newer ratio value backward
+        /* Carry newer ratio value backward */
         if(ISNA(real_div[i])) {
             rd_ratio[i-1] = rd_ratio[i];
         } else {
-        // Update dividend ratio
+        /* Update dividend ratio */
             rd_ratio[i-1] = rd_ratio[i] *
                 (1.0 - real_div[i] / real_close[i-1]);
         }
     }
 
-    // Assign results to list
+    /* Assign results to list */
     SET_VECTOR_ELT(result, 0, s_ratio);
     SET_VECTOR_ELT(result, 1, d_ratio);
 
-    // UNPROTECT R objects and return result
+    /* UNPROTECT R objects and return result */
     UNPROTECT(P);
     return(result);
 }
diff --git a/src/moving_averages.c b/src/moving_averages.c
@@ -1,5 +1,4 @@
 /*
- *
  *  TTR: Technical Trading Rules
  *
  *  Copyright (C) 2007-2010  Joshua M. Ulrich
@@ -23,119 +22,119 @@
 
 SEXP ema (SEXP x, SEXP n, SEXP ratio) {
 
-    // Initalize loop and PROTECT counters
+    /* Initalize loop and PROTECT counters */
     int i, P=0;
 
-    // assure that 'x' is double
+    /* assure that 'x' is double */
     if(TYPEOF(x) != REALSXP) {
       PROTECT(x = coerceVector(x, REALSXP)); P++;
     }
-    // assure that 'n' is integer
+    /* assure that 'n' is integer */
     if(TYPEOF(n) != INTSXP) {
       PROTECT(n = coerceVector(n, INTSXP)); P++;
     }
 
-    // Pointers to function arguments
+    /* Pointers to function arguments */
     double *d_x = REAL(x);
     int i_n = INTEGER(n)[0];
     double d_ratio = REAL(ratio)[0];
 
-    // Input object length
+    /* Input object length */
     int nr = nrows(x);
 
-    // Initalize result R object
+    /* Initalize result R object */
     SEXP result; PROTECT(result = allocVector(REALSXP,nr)); P++;
     double *d_result = REAL(result);
 
-    // Find first non-NA input value
+    /* Find first non-NA input value */
     int beg = i_n - 1;
     d_result[beg] = 0;
     for(i = 0; i <= beg; i++) {
-        // Account for leading NAs in input
+        /* Account for leading NAs in input */
         if(ISNA(d_x[i])) {
             d_result[i] = NA_REAL;
             beg++;
             d_result[beg] = 0;
             continue;
         }
-        // Set leading NAs in output
+        /* Set leading NAs in output */
         if(i < beg) {
             d_result[i] = NA_REAL;
         }
-        // Raw mean to start EMA
+        /* Raw mean to start EMA */
         d_result[beg] += d_x[i] / i_n;
     }
 
-    // Loop over non-NA input values
+    /* Loop over non-NA input values */
     for(i = beg+1; i < nr; i++) {
         d_result[i] = d_x[i] * d_ratio + d_result[i-1] * (1-d_ratio);
     }
 
-    // UNPROTECT R objects and return result
+    /* UNPROTECT R objects and return result */
     UNPROTECT(P);
     return(result);
 }
 
 SEXP evwma (SEXP pr, SEXP vo, SEXP n) {
 
-    // Initalize loop and PROTECT counters
+    /* Initalize loop and PROTECT counters */
     int i, P=0;
 
-    // assure that 'pr' is double
+    /* assure that 'pr' is double */
     if(TYPEOF(pr) != REALSXP) {
       PROTECT(pr = coerceVector(pr, REALSXP)); P++;
     }
-    // assure that 'vo' is double
+    /* assure that 'vo' is double */
     if(TYPEOF(vo) != REALSXP) {
       PROTECT(vo = coerceVector(vo, REALSXP)); P++;
     }
-    // assure that 'n' is integer
+    /* assure that 'n' is integer */
     if(TYPEOF(n) != INTSXP) {
       PROTECT(n = coerceVector(n, INTSXP)); P++;
     }
 
-    // Pointers to function arguments
+    /* Pointers to function arguments */
     double *d_pr = REAL(pr);
     double *d_vo = REAL(vo);
     int i_n = INTEGER(n)[0];
 
-    // Input object length
+    /* Input object length */
     int nr = nrows(pr);
 
-    // Initalize result R object
+    /* Initalize result R object */
     SEXP result; PROTECT(result = allocVector(REALSXP,nr)); P++;
     double *d_result = REAL(result);
 
-    // Volume Sum
+    /* Volume Sum */
     double volSum = 0;
 
-    // Find first non-NA input value
+    /* Find first non-NA input value */
     int beg = i_n - 1;
     for(i = 0; i <= beg; i++) {
-        // Account for leading NAs in input
+        /* Account for leading NAs in input */
         if(ISNA(d_pr[i]) || ISNA(d_vo[i])) {
             d_result[i] = NA_REAL;
             beg++;
             continue;
         }
-        // Set leading NAs in output
+        /* Set leading NAs in output */
         if(i < beg) {
             d_result[i] = NA_REAL;
-        // First result value is first price value
+        /* First result value is first price value */
         } else {
             d_result[i] = d_pr[i];
         }
-        // Keep track of volume Sum
+        /* Keep track of volume Sum */
         volSum += d_vo[i];
     }
 
-    // Loop over non-NA input values
+    /* Loop over non-NA input values */
     for(i = beg+1; i < nr; i++) {
         volSum = volSum + d_vo[i] - d_vo[i-i_n];
         d_result[i] = ((volSum-d_vo[i])*d_result[i-1]+d_vo[i]*d_pr[i])/volSum;
     }
 
-    // UNPROTECT R objects and return result
+    /* UNPROTECT R objects and return result */
     UNPROTECT(P);
     return(result);
 }

diff --git a/src/sar.c b/src/sar.c
@@ -1,5 +1,4 @@
 /*
- *
  *  TTR: Technical Trading Rules
  *
  *  Copyright (C) 2007-2010  Joshua M. Ulrich
@@ -23,10 +22,10 @@
 
 SEXP sar (SEXP hi, SEXP lo, SEXP xl) {
 
-    // Initalize loop and PROTECT counters
+    /* Initalize loop and PROTECT counters */
     int i, P=0;
 
-    // Ensure all arguments are double
+    /* Ensure all arguments are double */
     if(TYPEOF(hi) != REALSXP) {
       PROTECT(hi = coerceVector(hi, REALSXP)); P++;
     }
@@ -37,19 +36,19 @@ SEXP sar (SEXP hi, SEXP lo, SEXP xl) {
       PROTECT(xl = coerceVector(xl, REALSXP)); P++;
     }
 
-    // Pointers to function arguments
+    /* Pointers to function arguments */
     double *d_hi = REAL(hi);
     double *d_lo = REAL(lo);
     double *d_xl = REAL(xl);
 
-    // Input object length
+    /* Input object length */
     int nr = nrows(hi);
 
-    // Initalize result R object
+    /* Initalize result R object */
     SEXP sar; PROTECT(sar = allocVector(REALSXP,nr)); P++;
     double *d_sar = REAL(sar);
 
-    // Find first non-NA value
+    /* Find first non-NA value */
     int beg = 1;
     for(i=0; i < nr; i++) {
       if( ISNA(d_hi[i]) || ISNA(d_lo[i]) ) {
@@ -60,44 +59,38 @@ SEXP sar (SEXP hi, SEXP lo, SEXP xl) {
       }
     }
 
-    // Initialize values needed by the routine
+    /* Initialize values needed by the routine */
     int sig0 = 1, sig1 = 0;
     double xpt0 = d_hi[beg-1], xpt1 = 0;
     double af0 = d_xl[0], af1 = 0;
     double lmin, lmax;
     d_sar[beg-1] = d_lo[beg-1]-0.01;
 
     for(i=beg; i < nr; i++) {
-      // Increment signal, extreme point, and acceleration factor
+      /* Increment signal, extreme point, and acceleration factor */
       sig1 = sig0;
       xpt1 = xpt0;
       af1 = af0;
 
-      // Local extrema
+      /* Local extrema */
       lmin = (d_lo[i-1] < d_lo[i]) ? d_lo[i-1] : d_lo[i];
       lmax = (d_hi[i-1] > d_hi[i]) ? d_hi[i-1] : d_hi[i];
 
       /*
        * Create signal and extreme price vectors
        */
 
-      // Previous buy signal
+      /* Previous buy signal */
       if( sig1 == 1 ) {
 
-        // New signal
-        sig0 = (d_lo[i] > d_sar[i-1]) ? 1 : -1;
-
-        // New extreme price
-        xpt0 = (d_hi[i] > xpt1) ? d_hi[i] : xpt1;
+        sig0 = (d_lo[i] > d_sar[i-1]) ? 1 : -1;   /* New signal */
+        xpt0 = (d_hi[i] > xpt1) ? d_hi[i] : xpt1; /* New extreme price */
 
-      // Previous sell signal
+      /* Previous sell signal */
       } else {
-
-        // New signal
-        sig0 = (d_hi[i] < d_sar[i-1]) ? -1 : 1;
 
-        // New extreme price
-        xpt0 = (d_lo[i] < xpt1) ? d_lo[i] : xpt1;
+        sig0 = (d_hi[i] < d_sar[i-1]) ? -1 : 1;   /* New signal */
+        xpt0 = (d_lo[i] < xpt1) ? d_lo[i] : xpt1; /* New extreme price */
 
       }
 
@@ -106,50 +99,50 @@ SEXP sar (SEXP hi, SEXP lo, SEXP xl) {
        * and stop-and-reverse (sar) vector
        */
 
-      // No signal change
+      /* No signal change */
       if( sig0 == sig1 ) {
 
         d_sar[i] = d_sar[i-1] + ( xpt1 - d_sar[i-1] ) * af1;
 
-        // Current buy signal
+        /* Current buy signal */
         if( sig0 == 1 ) {
 
-          // Determine new acceleration factor vector value
+          /* Determine new acceleration factor vector value */
           if( xpt0 > xpt1 ) {
             af0 = (af1 == d_xl[1]) ? d_xl[1] : (d_xl[0] + af1);
           } else {
             af0 = af1;
           }
 
-          // Determine sar vector value
+          /* Determine sar vector value */
           if( d_sar[i] > lmin ) {
             d_sar[i] = lmin;
           }
 
-        // Current sell signal
+        /* Current sell signal */
         } else {
 
-          // Determine new acceleration factor vector value
+          /* Determine new acceleration factor vector value */
           if( xpt0 < xpt1 ) {
             af0 = (af1 == d_xl[1]) ? d_xl[1] : (d_xl[0] + af1);
           } else {
             af0 = af1;
           }
 
-          // Determine sar vector value
+          /* Determine sar vector value */
           if( d_sar[i] < lmax ) {
             d_sar[i] = lmax;
           }
         }
 
-      // New signal
+      /* New signal */
       } else {
         af0 = d_xl[0];
         d_sar[i] = xpt1;
       }
     }
 
-    // UNPROTECT R objects and return result
+    /* UNPROTECT R objects and return result */
     UNPROTECT(P);
     return(sar);
 }