[Rcpp-devel] What is the best practice to expose a C st ructure from 3rd party library into R?

[Dirk Eddelbuettel]

On 22 July 2013 at 13:19, romain at r-enthusiasts.com wrote:
| Le 2013-07-22 10:12, Wush Wu a écrit :
| > Hi all,
| >
| > I wrote a wrapper of hiredis, which is a minimalistic C client for 
| > the
| > Redis database. Its name is `Rhiredis` and is much faster than 
| > rredis,
| > an existed redis client of R. Please
| > see http://rpubs.com/wush978/rhiredis [1] for details. 
| 
| Cool.

Seconded. I love redis (and rredis).
 
| > Thanks for the Rcpp, it is much easier to wrap a C library into R and
| > extend the features of R. 
| 
| Great. That's why we do it.

Yup.
 
| > However, I still want to know if there is a better approach. I tried
| > three approaches. Here is my opinions.
| >
| > # Preliminary
| >
| > Given a 3rd party C library, it usually provides a C structure and
| > functions of memory management. For example:
| >
| > ```c
| >
| > struct A {
| >     int flag;
| >     // ...
| > };
| >
| > A* initA();
| > void freeA(A* a);
| > ```

I always use a _class_ instead of a struct to ge a ctor and dtor.

For database connections, this is _very_ useful:  from the load function of
your package, initialise the class (keep maybe as a package-global singleton
which is a common C++ pattern), and then the structure is keep around as long
as the package is loaded. You db interactions from R can then use it.

| > The structure `A` need to be stored into a R object and pass to
| > another function.
| > Also, the user might need to access `A.flag`. For simplicity, there 
| > is
| > only one field in this example. However, there might be a number of
| > fields in practice.
| >
| > # XPtr
| >
| >  Thanks for the user guide of Rcpp modules , this is the first
| > approach I tried.
| >
| > We could expose `A` into R as follow:
| >
| > ```cpp
| > Rcpp::XPtr<A, freeA> a(initA());
| > ```
| >
| > However, we should write helper function to accessing `A.flag` for
| > every fields.
| 
| Yes. And at the R level you deal with an external pointer. One usually 
| then have to maintain what they exactly mean in R.
| 
| > # RCPP_MODULE
| >
| > The guids of Rcpp modules also provides another approach:
| >
| > ```cpp
| >
| > RCPP_EXPOSED_CLASS(A)
| >
| > RCPP_MODULE(A) {
| >   class_<A>("A")
| >   .field("flag", &A::flag)
| >   ;
| >  }
| >
| > //@export
| > //[[Rcpp::export]]
| > SEXP init() {
| >   BEGIN_RCPP
| >   return wrap(*initA());
| >   END_RCPP
| > }
| > ```
| >
| > This will produce a S4 class named `A` in R which stores C structure
| > `A`.
| >
| > However, it also produces memory leak because no `freeA` is called.
| >
| > Adding `.finalizer(freeA)` in `RCPP_MODULE` will cause an error of
| > freeing memory twice.
| 
| Gotta look into why this happens.

I think we do have modules that work happily with finalizers. Hm.
 
| > # Embed `A` into C++ class and expose the class with RCPP_MODULE
| >
| > This approach is implemented in `Rhiredis`.
| >
| > Finally, I still need to write helper function to expose the field of
| > `A`. But the user could access these flag in R with operator `$`.
| >
| > Note that I still need a function to extract the pointer of `A` from
| > exposed S4 object:
| >
| > ```cpp
| >
| > template<class T>
| > T* extract_ptr(SEXP s) {
| >  Rcpp::S4 s4(s);
| >  Rcpp::Environment env(s4);
| >  Rcpp::XPtr<T> xptr(env.get(".pointer"));
| >  return static_cast<T*>(R_ExternalPtrAddr(xptr));
| > }
| > ```
| >
| > Please give me some suggestion if you know a better or a different
| > approach.
| 
| I would essentially do what you do: use RCPP_MODULE to expose a C++ 
| class so that the C++ class manages scoping : constructor, destructor, 
| etc ...
| 
| class A_cpp {
| public:
|      A_cpp( ) : obj( initA() ){}
|      ~A_cpp(){ freeA(obj); obj = NULL ; }
| 
|      int get_flag(){ return obj->flag ; }
|      void set_flag( int x ){ obj->flag = x ; }
| 
| private:
|      A* obj ;
| } ;

+1
 
| RCPP_MODULE(Whatever){
|      class_<A_cpp>( "A" )
|          .constructor()
|          .property( "flag", &A_cpp::get_flag, &A_cpp::set_flag )
|      ;
| }
| 
| Then in R:
| 
| a <- new( A )
| a$flag
| a$flag <- 12L
| a$flag
| 
| I would probably do some tricks with macros to avoid writing boiler 
| plate get_ and set_, something like this :
| 
| #define GET_SET(_type_,_name_)                  \
| _type_ get_##_name_(){ return obj->_name_ ; }   \
| void set_##_name_(_type_ x){ obj->_name_ = x ; }
| 
| so that you'd use:
| 
| GET_SET(int,flag)
| ...

When I wrapped database apis in the past, I knew I only need a small handful
of worker functions, so I just wrote the functions using plain old Rcpp. But
that was also before Modules.  Now I'd probably start with modules.

Dirk

 
| 
| With the devel version of Rcpp, you can use as to get hold of a 
| reference (or a const reference) of your object from the SEXP:
| 
| int get_flag( SEXP s4obj ){
|      A_cpp& obj = as<A_cpp&>( s4obj ) ;
|      return obj.get_flag() ;
| }
| 
| But you could also expose this simply as :
| 
| int get_flag( A_cpp& obj ){
|      return obj.get_flag() ;
| }
| 
| To have access to this "as", you have to declare some class traits, but 
| the RCPP_EXPOSED_CLASS can help you with this.
| Here is a working .cpp file that demonstrate all this.
| 
| #include <Rcpp.h>
| using namespace Rcpp ;
| 
| struct A{
|      int flag ;
| };
| 
| A* initA(){return new A() ; }
| void freeA(A* a){ delete a; }
| 
| #define GET_SET(_type_,_name_)                  \
| _type_ get_##_name_(){ return obj->_name_ ; }   \
| void set_##_name_(_type_ x){ obj->_name_ = x ; }
| 
| RCPP_EXPOSED_CLASS(A_cpp);
| class A_cpp {
| public:
|      A_cpp( ) : obj( initA() ){}
|      ~A_cpp(){ freeA(obj); obj = NULL ; }
| 
|      GET_SET(int,flag)
| 
| private:
|      A* obj ;
| } ;
| 
| int get_flag( SEXP s4obj ){
|      A_cpp& obj = as<A_cpp&>( s4obj ) ;
|      return obj.get_flag() ;
| }
| 
| RCPP_MODULE(Whatever){
|      class_<A_cpp>( "A" )
|          .constructor()
|          .property( "flag", &A_cpp::get_flag, &A_cpp::set_flag )
|      ;
|      function( "get_flag", &get_flag ) ;
| 
| }
| 
| 
| /*** R
| 
| a <- new( A )
| a$flag
| a$flag <- 12L
| a$flag
| get_flag( a )
| 
| ***/
| 
| I hope this clarifies a few things, or at least puts you on a good 
| track.
| 
| Let us know.
| 
| Romain
| 
| 
| 
| > Thanks.
| >
| > Wush
| >
| > Links:
| > ------
| > [1] http://rpubs.com/wush978/rhiredis
| _______________________________________________
| Rcpp-devel mailing list
| Rcpp-devel at lists.r-forge.r-project.org
| https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel
-- 
Dirk Eddelbuettel | edd at debian.org | http://dirk.eddelbuettel.com