Rcpp Version 0.12.12
OpenMPandInline.r
Go to the documentation of this file.
1 #!/usr/bin/env r
2 
3 library(inline)
4 library(rbenchmark)
5 
6 serialCode <- '
7  // assign to C++ vector
8  std::vector<double> x = Rcpp::as<std::vector< double > >(xs);
9  size_t n = x.size();
10  for (size_t i=0; i<n; i++) {
11  x[i] = ::log(x[i]);
12  }
13  return Rcpp::wrap(x);
14 '
15 funSerial <- cxxfunction(signature(xs="numeric"), body=serialCode, plugin="Rcpp")
16 
17 serialStdAlgCode <- '
18  std::vector<double> x = Rcpp::as<std::vector< double > >(xs);
19  std::transform(x.begin(), x.end(), x.begin(), ::log);
20  return Rcpp::wrap(x);
21 '
22 funSerialStdAlg <- cxxfunction(signature(xs="numeric"), body=serialStdAlgCode, plugin="Rcpp")
23 
24 ## same, but with Rcpp vector just to see if there is measurable difference
25 serialRcppCode <- '
26  // assign to C++ vector
27  Rcpp::NumericVector x = Rcpp::NumericVector(xs);
28  size_t n = x.size();
29  for (size_t i=0; i<n; i++) {
30  x[i] = ::log(x[i]);
31  }
32  return x;
33 '
34 funSerialRcpp <- cxxfunction(signature(xs="numeric"), body=serialRcppCode, plugin="Rcpp")
35 
36 serialStdAlgRcppCode <- '
37  Rcpp::NumericVector x = Rcpp::NumericVector(xs);
38  std::transform(x.begin(), x.end(), x.begin(), ::log);
39  return x;
40 '
41 funSerialStdAlgRcpp <- cxxfunction(signature(xs="numeric"), body=serialStdAlgRcppCode, plugin="Rcpp")
42 
43 serialImportTransRcppCode <- '
44  Rcpp::NumericVector x(xs);
45  return Rcpp::NumericVector::import_transform(x.begin(), x.end(), ::log);
46 '
47 funSerialImportTransRcpp <- cxxfunction(signature(xs="numeric"), body=serialImportTransRcppCode, plugin="Rcpp")
48 
49 ## now with a sugar expression with internalizes the loop
50 sugarRcppCode <- '
51  // assign to C++ vector
52  Rcpp::NumericVector x = log ( Rcpp::NumericVector(xs) );
53  return x;
54 '
55 funSugarRcpp <- cxxfunction(signature(xs="numeric"), body=sugarRcppCode, plugin="Rcpp")
56 
57 ## lastly via OpenMP for parallel use
58 openMPCode <- '
59  // assign to C++ vector
60  std::vector<double> x = Rcpp::as<std::vector< double > >(xs);
61  size_t n = x.size();
62 #pragma omp parallel for shared(x, n)
63  for (size_t i=0; i<n; i++) {
64  x[i] = ::log(x[i]);
65  }
66  return Rcpp::wrap(x);
67 '
68 
69 ## modify the plugin for Rcpp to support OpenMP
70 settings <- getPlugin("Rcpp")
71 settings$env$PKG_CXXFLAGS <- paste('-fopenmp', settings$env$PKG_CXXFLAGS)
72 settings$env$PKG_LIBS <- paste('-fopenmp -lgomp', settings$env$PKG_LIBS)
73 
74 funOpenMP <- cxxfunction(signature(xs="numeric"), body=openMPCode, plugin="Rcpp", settings=settings)
75 
76 
77 z <- seq(1, 2e6)
78 res <- benchmark(funSerial(z), funSerialStdAlg(z),
79  funSerialRcpp(z), funSerialStdAlgRcpp(z),
80  funSerialImportTransRcpp(z),
81  funOpenMP(z), funSugarRcpp(z),
82  columns=c("test", "replications", "elapsed",
83  "relative", "user.self", "sys.self"),
84  order="relative",
85  replications=100)
86 print(res)
87 
88