Rcpp Version 0.12.12
extractors.R
Go to the documentation of this file.
1 
2 require( inline )
3 require( Rcpp )
4 
5 inc <- '
6  SEXP direct__( SEXP x_, SEXP y_ ){
7  NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
8  int n = x.size() ;
9  for( int i=0; i<n; i++)
10  z[i] = x[i] * y[i] ;
11  return z ;
12  }
13 
14  SEXP extractors__( SEXP x_, SEXP y_){
15  NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
16  Fast<NumericVector> fx(x), fy(y), fz(z) ;
17  int n = x.size() ;
18  for( int i=0; i<n; i++)
19  fz[i] = fx[i] * fy[i] ;
20  return z ;
21  }
22 
23  SEXP sugar_nona__( SEXP x_, SEXP y_){
24  NumericVector x( x_ ), y( y_ ) ;
25  sugar::Nona< REALSXP, true, NumericVector > nx(x), ny(y) ;
26  NumericVector z = nx * ny ;
27  return z ;
28  }
29 '
30 
31 
32 fx <- cxxfunction(
33  list(
34  direct = signature( x_ = "numeric", y_ = "numeric" ),
35  extractor = signature( x_ = "numeric", y_ = "numeric" ),
36  sugar_nona = signature( x_ = "numeric", y_ = "numeric" ),
37 
38  assign_direct = signature( x_ = "numeric", y_ = "numeric" ),
39  assign_extractor = signature( x_ = "numeric", y_ = "numeric" ),
40  assign_sugar_nona = signature( x_ = "numeric", y_ = "numeric" )
41 
42  ) ,
43  list(
44  direct = '
45  SEXP res = R_NilValue ;
46  for( int j=0; j<1000; j++)
47  res = direct__( x_, y_ ) ;
48  return res ;
49  ',
50  extractor = '
51  SEXP res = R_NilValue ;
52  for( int j=0; j<1000; j++)
53  res = extractors__( x_, y_ ) ;
54  return res ;
55  ',
56  sugar_nona = '
57  SEXP res = R_NilValue ;
58  for( int j=0; j<1000; j++)
59  res = sugar_nona__( x_, y_ ) ;
60  return res ;
61  ',
62 
63  assign_direct = '
64  NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
65  int n = x.size() ;
66  for( int j=0; j<1000; j++)
67  for( int i=0; i<n; i++)
68  z[i] = x[i] * y[i] ;
69  return z ;
70  ',
71 
72  assign_extractor = '
73  NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
74  Fast<NumericVector> fx(x), fy(y), fz(z) ;
75  int n = x.size() ;
76  for( int j=0; j<1000; j++)
77  for( int i=0; i<n; i++)
78  fz[i] = fx[i] * fy[i] ;
79  return z ;
80  ',
81 
82  assign_sugar_nona = '
83  NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
84  sugar::Nona< REALSXP, true, NumericVector > nx(x), ny(y) ;
85  for( int j=0; j<1000; j++)
86  z = nx * ny ;
87  return z ;
88  '
89  ) , plugin = "Rcpp", includes = inc )
90 
91 x <- rnorm( 100000 )
92 y <- rnorm( 100000 )
93 
94 # resolving
95 invisible( getDynLib( fx ) )
96 
97 require( rbenchmark )
98 
99 benchmark(
100  fx$direct( x, y ),
101  fx$extractor( x, y ),
102  fx$sugar_nona( x, y ),
103 
104  replications = 1,
105  columns=c("test", "elapsed", "relative", "user.self", "sys.self"),
106  order="relative"
107 )
108 
109 benchmark(
110  fx$assign_direct( x, y ),
111  fx$assign_extractor( x, y ),
112  fx$assign_sugar_nona( x, y ),
113 
114  replications = 1,
115  columns=c("test", "elapsed", "relative", "user.self", "sys.self"),
116  order="relative"
117 )
118