[Rcpp-commits] r2184 - pkg/Rcpp/inst/examples/ConvolveBenchmarks

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Sep 26 01:11:33 CEST 2010


Author: edd
Date: 2010-09-26 01:11:33 +0200 (Sun, 26 Sep 2010)
New Revision: 2184

Modified:
   pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve7_c.c
Log:
updated to section 5.10.1 of R 2.11.1


Modified: pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve7_c.c
===================================================================
--- pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve7_c.c	2010-09-25 23:03:56 UTC (rev 2183)
+++ pkg/Rcpp/inst/examples/ConvolveBenchmarks/convolve7_c.c	2010-09-25 23:11:33 UTC (rev 2184)
@@ -6,20 +6,38 @@
 
 SEXP convolve7(SEXP a, SEXP b)
 {
-    int i, j, na, nb, nab;
+    /* int i, j, na, nb, nab; */
+    /* SEXP ab; */
+
+    /* PROTECT(a = AS_NUMERIC(a)); */
+    /* PROTECT(b = AS_NUMERIC(b)); */
+    /* na = LENGTH(a); nb = LENGTH(b); nab = na + nb - 1; */
+    /* PROTECT(ab = NEW_NUMERIC(nab)); */
+    /* for(i = 0; i < nab; i++) REAL(ab)[i] = 0.0; */
+    /* for(i = 0; i < na; i++) */
+    /* 	for(j = 0; j < nb; j++) REAL(ab)[i + j] += REAL(a)[i] * REAL(b)[j]; */
+    /* UNPROTECT(3); */
+    /* return(ab); */
+
+    R_len_t i, j, na, nb, nab;
+    double *xa, *xb, *xab;
     SEXP ab;
 
-    PROTECT(a = AS_NUMERIC(a));
-    PROTECT(b = AS_NUMERIC(b));
-    na = LENGTH(a); nb = LENGTH(b); nab = na + nb - 1;
-    PROTECT(ab = NEW_NUMERIC(nab));
-    for(i = 0; i < nab; i++) REAL(ab)[i] = 0.0;
+    PROTECT(a = coerceVector(a, REALSXP));
+    PROTECT(b = coerceVector(b, REALSXP));
+    na = length(a); nb = length(b); nab = na + nb - 1;
+    PROTECT(ab = allocVector(REALSXP, nab));
+    xa = REAL(a); xb = REAL(b);
+    xab = REAL(ab);
+    for(i = 0; i < nab; i++) xab[i] = 0.0;
     for(i = 0; i < na; i++)
-    	for(j = 0; j < nb; j++) REAL(ab)[i + j] += REAL(a)[i] * REAL(b)[j];
+	for(j = 0; j < nb; j++) xab[i + j] += xa[i] * xb[j];
     UNPROTECT(3);
     return(ab);
 }
 
+
+
 #include "loopmacro.h"
 LOOPMACRO_C(convolve7)
 



More information about the Rcpp-commits mailing list