[Rcpp-devel] RcppSexp again

[Romain François]

You are essentially going to end up with something similar to Simon's 
java REXP class. 
http://www.rforge.net/org/docs/index.html?org/rosuda/REngine/REXP.html

I'm not sure PROTECT/UNPROTECT is the best solution. It works fine when 
you nicely keep things balanced, but that's a pain and not very 
C++-like. I have not experimented it, but I think we should play with : 
R_PreserveObject/R_ReleaseObject which AFAICS keep things protected from 
GC without relying on the PROTECT stack.

=== (From src/main/memory.c)

/* This code keeps a list of objects which are not assigned to variables
    but which are required to persist across garbage collections.  The
    objects are registered with R_PreserveObject and deregistered with
    R_ReleaseObject. */

void R_PreserveObject(SEXP object)
{
     R_PreciousList = CONS(object, R_PreciousList);
}

void R_ReleaseObject(SEXP object)
{
     R_PreciousList =  RecursiveRelease(object, R_PreciousList);
}

Romain

On 12/16/2009 05:25 AM, Dirk Eddelbuettel wrote:
>
> I think I am getting my head wrapped around this. I want a super-simple class
> as 'data passthrough' -- C++ types in from SEXPs we get from R, and C++ types
> out via SEXPs we send to R.  Here is a basic implementation supporting just a
> 'double'.
>
> -----------------------------------------------------------------------------
> #ifndef RcppSexp_h
> #define RcppSexp_h
>
> #include<RcppCommon.h>
>
> class RcppSexp {
> public:
>      RcppSexp(SEXP sexp, int numprot=0) : m_sexp(sexp), m_nprot(numprot) {}
>      RcppSexp() : m_sexp(R_NilValue), m_nprot(0) {}
>
>      RcppSexp(const double&  d) {
> 	m_sexp = PROTECT(Rf_allocVector(REALSXP, 1));
> 	m_nprot++;
> 	REAL(m_sexp)[0] = d;
>      }
>
>      ~RcppSexp() {
> 	UNPROTECT(m_nprot);
>      }
>
>      double asDouble() {
> 	if (Rf_length(m_sexp) != 1) {
> 	    throw std::range_error("RcppSexp::asDouble expects single value");
> 	}
> 	if (!Rf_isNumeric(m_sexp)) {
> 	    throw std::range_error("RcppSexp::asDouble expect numeric type");
> 	}
> 	if (Rf_isInteger(m_sexp)) {
> 	    return (double)INTEGER(m_sexp)[0];
> 	} else if (Rf_isReal(m_sexp)) {
> 	    return REAL(m_sexp)[0];
> 	} else {
> 	    throw std::range_error("RcppSexp::asDouble invalid type");
> 	}
> 	return 0; // never gets here
>      }
>
>      SEXP asSexp() {
> 	return m_sexp;
>      }
>
> private:
>      SEXP m_sexp;
>      int m_nprot;
> };
>
> #endif
> -----------------------------------------------------------------------------
>
> which, thanks to Oleg's inline and my adaptation thereof, can be used via
>
>
> -----------------------------------------------------------------------------
> #!/usr/bin/r
>
> suppressMessages(library(Rcpp))
>
> foo<- '
>          double d = RcppSexp(x).asDouble();
> 	std::cout<<  "d is "<<  d<<  std::endl;
>          '
> funx<- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
> funx(x=2.123)
> funx(x=2)
> #funx(x='2')  ## throws as expected
> #funx(x=2:3)  ## throws as expected
>
>
> foo<- '
>          double d = RcppSexp(x).asDouble();
> 	std::cout<<  "Returning twice the value of "<<  d<<  std::endl;
> 	return(RcppSexp( 2*d ).asSexp());
>          '
> funx<- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
> print(funx(x=2.123))
> -----------------------------------------------------------------------------
>
>
> The last example is particularly nice.  One line to go from a SEXP (with
> signature  'numeric' as per the argument to cfunction() ) to a C++ double,
> and the same on the way out:  create an RcppSexp and return it as a plain
> SEXP:
>
> -----------------------------------------------------------------------------
> edd at ron:~/svn/rcpp$ pkg/inst/examples/RcppInline/RcppSexpTests.r
> d is 2.123
> d is 2
> Returning twice the value of 2.123
> [1] 4.246
> edd at ron:~/svn/rcpp$
> -----------------------------------------------------------------------------
>
>
> Should work similarly for your vectors of strings of whatever that original
> example was.
>
> Dirk


-- 
Romain Francois
Professional R Enthusiast
+33(0) 6 28 91 30 30
http://romainfrancois.blog.free.fr
|- http://tr.im/HlX9 : new package : bibtex
|- http://tr.im/Gq7i : ohloh
`- http://tr.im/FtUu : new package : highlight