[Rcpp-devel] rcpp_modules: Passing object pointer back to C++

Mr.M at gmx.at Mr.M at gmx.at
Sun Jan 22 21:34:04 CET 2012


Hello Jelmer,

Thank you so much for your answer.
It works! I have not found any issues with the solution so far. (On Linux-64bit)

I implemented it the following way (I used "TestClass2" as the class in the argument to make it a little clearer):

--

int TestClass::doSomething(SEXP s)
{
  std::string rtypename("Rcpp_TestClass2");

  // if ( TYPEOF(s) != S4SXP ) { ... } //This can be left away, because the constructor of S4 checks that.

  Rcpp::S4 s4obj( s );

  if ( !s4obj.is( rtypename.c_str() ) ) {
    Rf_error( (std::string("object is not of the type ")+rtypename).c_str() );
  }

  Rcpp::Environment env( s4obj );
  Rcpp::XPtr<TestClass2> xptr( env.get(".pointer") );

  TestClass2 *o = static_cast<TestClass2*> (R_ExternalPtrAddr(xptr));

  return o->a + a;
  //or
  //return o->getA() + a; 
  //or
  //return o->doSomethingElse();
  //or whatever

}

--

In R the code is called via

a = new (MyPackage::TestClass)
b = new (MyPackage::TestClass2)
a$doSomething(b)

When using Rcpp_modules, this basically allows passing an arbitrary C++ object back to C++ and accessing its members.


regards, Michael M.

If I run into a situation where the passed object reference is stored as a class member, I will try to attach an additional finalizer to the passed object which "disables" all function calls inside the current object (to avoid segfaults)
However currently this is not an issue, because the pointer is not stored.


-------- Original-Nachricht --------
> Datum: Sun, 22 Jan 2012 15:18:05 +0000
> Von: Jelmer Ypma <jelmerypma at gmail.com>
> An: Mr.M at gmx.at
> CC: rcpp-devel at r-forge.wu-wien.ac.at
> Betreff: Re: [Rcpp-devel] rcpp_modules: Passing object pointer back to C++

> Hi Michael,
> 
> I ran into a similar problem this week when trying to wrap/as a class
> that is exposed to R using modules. In the end, the example below
> solved my problem, although it's probably not the most efficient
> solution.
> 
> If I understand your question correctly, you probably want something
> similar to what's implemented in as<TestClass> below. The pointer to
> the underlying C++ class is obtained by Rcpp::XPtr<TestClass> xptr(
> env.get(".pointer") ). You can then use xptr to access the function in
> the class, copy the values of members, etc. Probably you can also
> convert it to a raw pointer if that's what you need, but I'm not sure
> whether that would be safe.
> 
> I hope this helps at least somewhat.
> 
> Best wishes,
> Jelmer
> 
> 
> ====================
> library('inline')
> library('Rcpp')
> 
> # Declare TestClass class and Rcpp::wrap, and Rcpp::as
> TestClassForwardCode <- '
> #include <RcppCommon.h>
> 
> // declare TestClass class
> class TestClass
> {
> 	public:
> 		TestClass( int i );
> 		int const value() const;
> 	private:
> 		int d_val;
> 
>         // The program does not compile, if we make this copy
> constructor private.
>         // explicit TestClass(const TestClass& original);
> };
> 
> // declaring the specialization
> namespace Rcpp {
>     template <> SEXP wrap( const TestClass& );
>     template <> TestClass as( SEXP ) throw(not_compatible);
> }
> 
> // this must appear after the specialization,
> // otherwise the specialization will not be seen by Rcpp types
> '
> 
> # Implementation of as and wrap code
> TestClassAsWrapCode <- '
> namespace Rcpp {
>     template <> SEXP wrap<TestClass>( const TestClass& el ) {
>         int val = el.value();
>         Rcpp::Language call( "new", Symbol( "TestClass" ), val ) ;
>         return call.eval() ;
>     };
> 
>     template <> TestClass as<TestClass>( SEXP s ) throw(not_compatible) {
>         try {
>             if ( TYPEOF(s) != S4SXP ) {
>                 ::Rf_error( "supplied object is not of type TestClass." );
>             }
> 
>             Rcpp::S4 s4obj( s );
>             if ( !s4obj.is("Rcpp_TestClass" ) ) {
>                 ::Rf_error( "supplied object is not of type TestClass." );
>             }
> 
>             Rcpp::Environment env( s4obj );
>             Rcpp::XPtr<TestClass> xptr( env.get(".pointer") );
> 
>             // build new TestClass object with copied data
>             return TestClass( xptr->value() );
>         }
>         catch(...) {
>             ::Rf_error( "supplied object could not be converted to
> TestClass." );
>         }
>     };
> }
> '
> 
> # Implementation of TestClass class and two functions
> # that require wrap<TestClass> or as<TestClass>
> TestClassImplementation <- '
> // implementation of TestClass class
> TestClass::TestClass( int i ) : d_val( i ) {}
> 
> int const TestClass::value() const
> {
>     return d_val;
> }
> 
> 
> // definition and implementation of function using TestClass
> int useTestClass( TestClass ee ) {
>     Rcpp::Rcout << "Multiply value in TestClass by 2." << std::endl;
>     return 2 * ee.value();
> }
> 
> // definition and implementation of function returning TestClass
> TestClass returnTestClass( int val ) {
>     Rcpp::Rcout << "Create and return a TestClass." << std::endl;
>     return TestClass( val );
> }
> '
> 
> # Implementation of module code
> TestModuleCode <- '
> RCPP_MODULE(Test_module) {
>     // expose TestClass class
>     class_<TestClass>( "TestClass" )
>         .constructor<int>()
>        .method( "value", &TestClass::value )
>     ;
> 
>     function( "useTestClass", &useTestClass );
>     function( "returnTestClass", &returnTestClass );
> }
> '
> 
> # Create plugin to add wrap and as for TestClass
> plug <- function(){
> 	settings <- getPlugin( "Rcpp" )
>     settings$includes <- paste( TestClassForwardCode,
> settings$include, TestClassAsWrapCode )
>     return( settings )
> }
> registerPlugin( "RcppTestWrap", plug )
> 
> # Compile module, and extract classes TestClass and Container
> test_mod <- cxxfunction( signature(),
>                          body = "",
>                          include = paste(TestClassImplementation,
> TestModuleCode, sep='\n'),
>                          plugin = "RcppTestWrap", verbose=TRUE )
> Test_module   <- Module( "Test_module", getDynLib(test_mod) )
> TestClass       <- Test_module$TestClass
> useTestClass    <- Test_module$useTestClass
> returnTestClass <- Test_module$returnTestClass
> 
> # Create new TestClass
> obj1 <- new( TestClass, 5 )
> obj1$value()
> useTestClass( obj1 )
> 
> obj2 <- returnTestClass( 4 )
> obj2$value()
> useTestClass( obj2 )
> ====================
> 
> On Sun, Jan 22, 2012 at 14:43,  <Mr.M at gmx.at> wrote:
> > Hello there,
> >
> > I am implementing a package with rcpp_modules which basically worked
> fine until I tried to add a method which allows the user to do the following
> in R:
> >
> > a = new (MyPackage::MyClass)
> > b = new (MyPackage::MyClass)
> > a.doSomething(b)
> >
> > -------
> >
> > The code behind looks somewhat like this:
> >
> > #include <Rcpp.h>
> > class MyClass {
> > public:
> >
> >  int a;
> >
> >  MyClass(int a_){a = a_};
> >
> >  //Option1
> >  void doSomething(MyClass * ref){
> >    return ref->a + a;
> >  }
> >  //Option2
> >  void doSomething(SEXP sx){
> >    MyClass * ref = //what to write here???
> >    return ref->a + a;
> >  }
> >  //End
> >
> > };
> >
> >
> > RCPP_MODULE(yada) {
> > class_<Uniform>( "Uniform" )
> > .constructor<int>()
> > .field( "a", &MyClass::a )
> > .method( "doSomething", &MyClass::doSomething )
> > ;
> > }
> >
> > ----------
> >
> > So, what I am trying to do, is to get a C++ pointer to the (C++) object
> of the method-argument.
> >
> > Option 1 does not work, because the MyClass * is not an Rcpp compatible
> type:
> > "error: cannot convert ‘SEXP’ to ‘MyClass*’ in initialization"
> >
> > With Option 2 I have not figured out, how to cast the SEXP to something
> useful. It definitely is a S4SXP with one slot ".xData". The contents of
> this slot are something like "<environment: 0x2b2f830>".
> >
> > So my question now is: Is this the memory address of the C++ object?
> > If it is, how can I assign this address to a C++ pointer of type
> "MyClass *" ?
> > Is there any other possibility to unwrap rcpp_module's S4SXP datatypes
> to C++ pointers?
> >
> > (I am aware that R garbage-collects the object when it goes out of
> scope; This is no problem in this scenario)
> >
> > ------
> >
> > So far I have (unsuccessfully) tried:
> >
> > MyClass *ref = static_cast<MyClass*> (R_ExternalPtrAddr(n));
> >
> > if( TYPEOF( sx ) == S4SXP  )  MyClass* ref = (MyClass*) EXTPTR_PTR(
> R_do_slot( sx , Rf_install(".xData") ) ) ;
> >
> > if( TYPEOF( sx ) == S4SXP  )  MyClass* ref = (MyClass*) R_do_slot( sx
> , Rf_install(".xData") );
> >
> > Rcpp::S4 a = Rcpp::S4(sx); MyClass* ref = (MyClass*)
> a.slot(".xData")<MyClass*>;
> >
> >
> > The first three result in a memory error. The last one is syntactically
> incorrect, because I have not figured out how to correctly use the template
> operator of SlotProxy.
> >
> > -------
> >
> > A somewhat related thread is:
> http://lists.r-forge.r-project.org/pipermail/rcpp-devel/2011-December/003223.html
> >
> > Any help is appreciated.
> > (The only thing that mustn't be changed is "a.doSomething(b)".)
> >
> >
> > regards, Michael
> >
> > By the way... I think that rcpp_modules is a great tool and will be
> widely used in future.
> >
> > --
> > "Feel free" - 10 GB Mailbox, 100 FreeSMS/Monat ...
> > Jetzt GMX TopMail testen: http://www.gmx.net/de/go/topmail
> > _______________________________________________
> > 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

-- 
"Feel free" - 10 GB Mailbox, 100 FreeSMS/Monat ...
Jetzt GMX TopMail testen: http://www.gmx.net/de/go/topmail


More information about the Rcpp-devel mailing list