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

[Jelmer Ypma]

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