RInside Version 0.2.12
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros
rinside_sample17.cpp
Go to the documentation of this file.
1 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
2 //
3 // More elaborate examples for exposing functions using C++11
4 //
5 // Copyright (C) 2014 Christian Authmann
6 
7 #include <iostream>
8 
9 #include <RcppCommon.h>
10 
11 #if !defined(RCPP_USING_CXX11)
12 int main(int argc, char *argv[]) {
13  std::cout << "This example requires a c++11 compatible compiler. Upgrade your compiler and/or add the -std=c++11 compiler option.\n";
14  exit(0);
15 }
16 #elif RCPP_VERSION < Rcpp_Version(0,11,3)
17 int main(int argc, char *argv[]) {
18  std::cout << "This example requires Rcpp 0.11.3 or later. Upgrade Rcpp and recompile this example.\n";
19  exit(0);
20 }
21 #else
22 
23 #include <memory>
24 
25 /*
26  * We have a simple data type with two values.
27  *
28  * Just to make it less simple (and more educational), this class is not copyable,
29  * preventing it from being used as a function parameter or return type.
30  */
31 class Foo {
32  public:
33  Foo(int a, int b) : a(a), b(b) {
34  }
35  ~Foo() {
36  }
37 
38  private:
39  Foo(const Foo &f) : a(f.a), b(f.b) {
40  throw "Cannot copy construct Foo";
41  }
42 
43  Foo &operator=(const Foo &f) {
44  throw "Cannot copy assign Foo";
45  }
46 
47  public:
48  int a, b;
49 };
50 
51 
52 /*
53  * We define converters between Foo and R objects, see
54  * http://cran.r-project.org/web/packages/Rcpp/vignettes/Rcpp-extending.pdf
55  *
56  * These template declarations must be after RcppCommon.h and before Rcpp.h
57  * The implementation can follow later, when all of Rcpp/Rinside is available.
58  *
59  * Since Foo is not copyable, we need a workaround. Instead of passing Foo
60  * directly, we pass C++11's std::unique_ptr<Foo> - which is movable.
61  * Note that the older std::auto_ptr does not work.
62  */
63 namespace Rcpp {
64  template<> SEXP wrap(const Foo &f);
65  template<> SEXP wrap(const std::unique_ptr<Foo> &f);
66  template<> std::unique_ptr<Foo> as(SEXP sexp);
67 }
68 
69 #include <Rcpp.h>
70 #include <RInside.h>
71 
72 
73 /*
74  * After including Rcpp/Rinside, we can implement the converters.
75  */
76 
77 // An implementation for unique_ptr
78 template<> SEXP Rcpp::wrap(const std::unique_ptr<Foo> &f) {
79  return Rcpp::wrap(*f);
80 }
81 
82 // And an implementation for a non-wrapped object
83 template<> SEXP Rcpp::wrap(const Foo &f) {
84  Rcpp::List list;
85 
86  list["a"] = f.a;
87  list["b"] = f.b;
88 
89  return Rcpp::wrap(list);
90 }
91 
92 // Converting the R object back to a C++ object will always return a unique_ptr
93 template<> std::unique_ptr<Foo> Rcpp::as(SEXP sexp) {
94  Rcpp::List list = Rcpp::as<Rcpp::List>(sexp);
95  int a = list["a"];
96  int b = list["b"];
97 
98  // With c++14, we'd use std::make_unique<Foo>(a, b) here
99  return std::unique_ptr<Foo>(new Foo(a, b));
100 }
101 
102 
103 // C++ functions we wish to expose to R
104 std::unique_ptr<Foo> swapFoo(std::unique_ptr<Foo> input) {
105  return std::unique_ptr<Foo>(new Foo(input->b, input->a));
106 }
107 
108 std::unique_ptr<Foo> addFoo(std::unique_ptr<Foo> foo1, std::unique_ptr<Foo> foo2) {
109  return std::unique_ptr<Foo>(new Foo(foo1->a + foo2->a, foo1->b + foo2->b));
110 }
111 
112 /*
113  * Let's also assume that we have some kind of data source. We want R scripts to be able
114  * to query the database without actually exposing the database class.
115  */
116 class FooDatabase {
117  public:
118  FooDatabase(int database_id) : database_id(database_id) {
119  }
120  // R scripts will want to call this..
121  std::unique_ptr<Foo> queryFoo(int id) {
122  return std::unique_ptr<Foo>(new Foo(database_id, id));
123  }
124  // ..but really should not be allowed call this.
125  void destroyDatabase() {
126  throw "boom!";
127  }
128  private:
129  int database_id;
130 };
131 
132 
133 int main(int argc, char *argv[]) {
134  // create an embedded R instance
135  RInside R(argc, argv);
136 
137  // expose the "swapFoo" and "addFoo" functions in the global environment
138  R["swapFoo"] = Rcpp::InternalFunction( &swapFoo );
139  R["addFoo"] = Rcpp::InternalFunction( &addFoo );
140 
141  // We can also expose C++11's std::function, for example to grant access to these three "databases"
142  FooDatabase db1(1), db2(2), db3(3);
143 
144  // All data from DB1 can be queried
145  std::function< std::unique_ptr<Foo>(int) > queryDB1 = std::bind(&FooDatabase::queryFoo, std::ref(db1), std::placeholders::_1);
146  R["queryDB1"] = Rcpp::InternalFunction( queryDB1 );
147 
148  // DB2 shall only be queried with id=42
149  std::function< std::unique_ptr<Foo>() > queryDB2 = std::bind(&FooDatabase::queryFoo, std::ref(db2), 42);
150  R["queryDB2"] = Rcpp::InternalFunction( queryDB2 );
151 
152  // For DB3, let's do some more complicated permission checks. That's a good excuse to use a lambda.
153  std::function< std::unique_ptr<Foo>(int) > queryDB3 =
154  [&db3] (int id) -> std::unique_ptr<Foo> {
155  if (id < 0 || id > 20)
156  throw "id out of allowed range";
157  return db3.queryFoo(id);
158  };
159  R["queryDB3"] = Rcpp::InternalFunction( queryDB3 );
160 
161 
162  std::unique_ptr<Foo> result = R.parseEvalNT(
163  "foo1 = queryDB1(20);"
164  //"print(foo1);" // a=1, b=20
165  "foo2 = queryDB2();"
166  //"print(foo2);" // a=2, b=42
167  "foo3 = queryDB3(10);"
168  //"print(foo3);" // a=3, b=10
169 
170  "foo1 = swapFoo(foo1);"
171  //"print(foo1);" // a=20, b=1
172  "foo = addFoo(foo1, addFoo(foo2, foo3));"
173  //"print(foo);" // a=25, b=53
174 
175  "foo;" // return the object
176  );
177 
178  std::cout << " Got result a=" << result->a << ", b=" << result->b << std::endl;
179  std::cout << " Expected a=25, b=53" << std::endl;
180 }
181 
182 #endif
Definition: foo.h:17
SEXP wrap(const Bar &bar)
Foo swapFoo(Foo &input)
Foo(const std::string &name, int32_t a, int32_t b)
Definition: foo.cpp:4
int32_t a
Definition: foo.h:23
int32_t b
Definition: foo.h:23
~Foo()
Definition: foo.cpp:8
int main(int argc, char *argv[])
Bar as(SEXP sexp)