rcpp/html/extractors_8R_source.html

00001
00002 require( inline )
00003 require( Rcpp )
00004
00005 inc <- '
00006     SEXP direct__( SEXP x_, SEXP y_ ){
00007         NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
00008         int n = x.size() ;
00009         for( int i=0; i<n; i++)
00010             z[i] = x[i] * y[i] ;
00011         return z ;
00012     }
00013
00014     SEXP extractors__( SEXP x_, SEXP y_){
00015         NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
00016         Fast<NumericVector> fx(x), fy(y), fz(z)  ;
00017         int n = x.size() ;
00018         for( int i=0; i<n; i++)
00019             fz[i] = fx[i] * fy[i] ;
00020         return z ;
00021     }
00022
00023     SEXP sugar_nona__( SEXP x_, SEXP y_){
00024         NumericVector x( x_ ), y( y_ ) ;
00025         sugar::Nona< REALSXP, true, NumericVector > nx(x), ny(y) ;
00026         NumericVector z = nx * ny ;
00027         return z ;
00028     }
00029 '
00030
00031
00032 fx <- cxxfunction(
00033     list(
00034         direct = signature( x_ = "numeric", y_ = "numeric" ),
00035         extractor = signature( x_ = "numeric", y_ = "numeric" ),
00036         sugar_nona = signature( x_ = "numeric", y_ = "numeric" ),
00037
00038         assign_direct = signature( x_ = "numeric", y_ = "numeric" ),
00039         assign_extractor = signature( x_ = "numeric", y_ = "numeric" ),
00040         assign_sugar_nona = signature( x_ = "numeric", y_ = "numeric" )
00041
00042     ) ,
00043     list(
00044         direct = '
00045         SEXP res = R_NilValue ;
00046         for( int j=0; j<1000; j++)
00047             res = direct__( x_, y_ ) ;
00048         return res ;
00049         ',
00050         extractor = '
00051         SEXP res = R_NilValue ;
00052         for( int j=0; j<1000; j++)
00053             res = extractors__( x_, y_ ) ;
00054         return res ;
00055         ',
00056         sugar_nona = '
00057         SEXP res = R_NilValue ;
00058         for( int j=0; j<1000; j++)
00059             res = sugar_nona__( x_, y_ ) ;
00060         return res ;
00061         ',
00062
00063         assign_direct = '
00064         NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
00065         int n = x.size() ;
00066         for( int j=0; j<1000; j++)
00067             for( int i=0; i<n; i++)
00068                 z[i] = x[i] * y[i] ;
00069         return z ;
00070         ',
00071
00072         assign_extractor = '
00073         NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
00074         Fast<NumericVector> fx(x), fy(y), fz(z)  ;
00075         int n = x.size() ;
00076         for( int j=0; j<1000; j++)
00077             for( int i=0; i<n; i++)
00078                 fz[i] = fx[i] * fy[i] ;
00079         return z ;
00080         ',
00081
00082         assign_sugar_nona = '
00083         NumericVector x( x_ ), y( y_ ), z( x.size() ) ;
00084         sugar::Nona< REALSXP, true, NumericVector > nx(x), ny(y) ;
00085         for( int j=0; j<1000; j++)
00086             z = nx * ny ;
00087         return z ;
00088         '
00089     ) , plugin = "Rcpp", includes = inc )
00090
00091 x <- rnorm( 100000 )
00092 y <- rnorm( 100000 )
00093
00094 # resolving
00095 invisible( getDynLib( fx ) )
00096
00097 require( rbenchmark )
00098
00099 benchmark(
00100     fx$direct( x, y ),
00101     fx$extractor( x, y ),
00102     fx$sugar_nona( x, y ),
00103
00104     replications = 1,
00105     columns=c("test", "elapsed", "relative", "user.self", "sys.self"),
00106     order="relative"
00107 )
00108
00109 benchmark(
00110     fx$assign_direct( x, y ),
00111     fx$assign_extractor( x, y ),
00112     fx$assign_sugar_nona( x, y ),
00113
00114     replications = 1,
00115     columns=c("test", "elapsed", "relative", "user.self", "sys.self"),
00116     order="relative"
00117 )
00118