rcpp/html/RcppSimpleExample_8r_source.html

00001 #!/usr/bin/r
00002
00003
00004 suppressMessages(library(Rcpp))
00005 suppressMessages(library(inline))
00006
00007
00008 foo <- '
00009   int i, j, na, nb, nab;
00010   double *xa, *xb, *xab;
00011   SEXP ab;
00012
00013   PROTECT(a = AS_NUMERIC(a));
00014   PROTECT(b = AS_NUMERIC(b));
00015   na = LENGTH(a); nb = LENGTH(b); nab = na + nb - 1;
00016   PROTECT(ab = NEW_NUMERIC(nab));
00017   xa = NUMERIC_POINTER(a); xb = NUMERIC_POINTER(b);
00018   xab = NUMERIC_POINTER(ab);
00019   for(i = 0; i < nab; i++) xab[i] = 0.0;
00020   for(i = 0; i < na; i++)
00021     for(j = 0; j < nb; j++) xab[i + j] += xa[i] * xb[j];
00022   UNPROTECT(3);
00023   return(ab);
00024 '
00025
00026 funx <- cfunction(signature(a="numeric",b="numeric"), foo, Rcpp=FALSE, verbose=FALSE)
00027 funx(a=1:20, b=2:11)