[Rcpp-devel] Rcpp: Distinguishing between input types to function call

[Kevin Ushey]

Hi Romain,

Just wanted to give you a thanks for putting together this answer. It's a
really great example of more generic programming with Rcpp by templating
over the RTYPEs.

You should consider submitting some version of this to the Rcpp gallery; I
think it has a lot of use cases.

-Kevin

On Wed, Feb 20, 2013 at 12:53 AM, Romain Francois
<romain at r-enthusiasts.com>wrote:

> Hello,
>
> Here is a shorter version of your code. The key idea was to use TYPEOF
> instead of Rf_inherits which uses the class attribute (simple vectors don't
> have them).
>
> #include <Rcpp.h>
> using namespace Rcpp;
>
> template <int RTYPE>
>
> SEXP allpairsXtemplate_( SEXP XX_ ){
>   Vector<RTYPE> X(XX_);
>   Matrix<RTYPE> ans(2, X.size()*(X.size()-1)/2);
>
>   int col=0;
>   for (int ii=0; ii<X.size(); ii++){
>     for (int jj=ii+1; jj<X.size(); jj++){
>       ans(0,col) = X(ii);
>       ans(1,col++) = X(jj);
>     }
>   }
>   return ans ;
> };
>
> // [[Rcpp::export]]
>
> SEXP allpairsX_ ( SEXP XX_ ){
>     int type = TYPEOF(XX_) ;
>     switch( type ){
>         case INTSXP : return allpairsXtemplate_<INTSXP> ( XX_ ) ;
>         case REALSXP: return allpairsXtemplate_<REALSXP>( XX_ ) ;
>         case STRSXP : return allpairsXtemplate_<STRSXP> ( XX_ ) ;
>     }
>     return R_NilValue ;
> }
>
>
> /*** R
>
>
> XX1 <- letters[1:4] # character
> XX2 <- 1:4          # integer
> XX3 <- (1:4)+.5     # numeric
>
> allpairsX_( XX1 )
> allpairsX_( XX2 )
> allpairsX_( XX3 )
>
> ***/
>
> Also, I'm templating allpairsXtemplate_ on the R type rather than the
> actual classes, because NumericVector = Vector<REALSXP>, etc ...
>
>
> About your code, with e.g. TT = NumericVector, you don't need as in :
>
>
> TT X = as<TT>(XX_);
>
> because NumericVector already has a SEXP constructor, that is why I do:
> Vector<RTYPE> X(XX_);
>
>
>
> Same for return(wrap(ans));  you don't need to call wrap here because ans
> can convert itself to SEXP.
>
>
>
> Another way to write this using Rcpp's builtin dispatch mechanism is to
> use RCPP_RETURN_VECTOR. For example :
>
> #include <Rcpp.h>
> using namespace Rcpp;
>
> template <typename T>
> SEXP allpairsXtemplate_( const T& X){
>   const int RTYPE = T::r_type::value ;
>   Matrix<RTYPE> ans(2, X.size()*(X.size()-1)/2);
>
>   int col=0;
>   for (int ii=0; ii<X.size(); ii++){
>     for (int jj=ii+1; jj<X.size(); jj++){
>       ans(0,col) = X(ii);
>       ans(1,col++) = X(jj);
>     }
>   }
>   return ans ;
> };
>
> // [[Rcpp::export]]
>
> SEXP allpairsX_ ( SEXP XX_ ){
>     RCPP_RETURN_VECTOR( allpairsXtemplate_, XX_ ) ;
>     return R_NilValue ; // never used
> }
>
>
> So we call one of the generated overloads of allpairsXtemplate_ which
> takes a Vector as input. From this vector, we can deduce the RTYPE (at
> compile time):
>
> const int RTYPE = T::r_type::value ;
>
> use it to get the correct Matrix type : Matrix<RTYPE>.
>
>
>
> Yet another way, probably the one I would use:
>
> template <int RTYPE>
> Matrix<RTYPE> allpairsXtemplate_( const Vector<RTYPE>& X){
>   Matrix<RTYPE> ans(2, X.size()*(X.size()-1)/2);
>
>   int col=0;
>   for (int ii=0; ii<X.size(); ii++){
>     for (int jj=ii+1; jj<X.size(); jj++){
>       ans(0,col) = X(ii);
>       ans(1,col++) = X(jj);
>     }
>   }
>   return ans ;
> };
>
> This works because RCPP_RETURN_VECTOR will cast to the appropriate Vector
> type.
>
> And knowing the RTYPE at first lets us use it on the output signture.
>
>
> RCPP_RETURN_VECTOR is defined in dispatch.h (macro haters beware):
>
> #define ___RCPP_HANDLE_CASE___( ___RTYPE___ , ___FUN___ , ___OBJECT___ ,
> ___RCPPTYPE___ )       \
>         case ___RTYPE___ :
>
>          \
>                 return ___FUN___( ::Rcpp::___RCPPTYPE___< ___RTYPE___ >(
> ___OBJECT___ ) ) ;
>
> #define ___RCPP_RETURN___( __FUN__, __SEXP__ , __RCPPTYPE__ )
>                               \
>         SEXP __TMP__ = __SEXP__ ;
>
>   \
>         switch( TYPEOF( __TMP__ ) ){
>                                                                      \
>                 ___RCPP_HANDLE_CASE___( INTSXP  , __FUN__ , __TMP__ ,
> __RCPPTYPE__ )                    \
>                 ___RCPP_HANDLE_CASE___( REALSXP , __FUN__ , __TMP__ ,
> __RCPPTYPE__ )                    \
>                 ___RCPP_HANDLE_CASE___( RAWSXP  , __FUN__ , __TMP__ ,
> __RCPPTYPE__ )                    \
>                 ___RCPP_HANDLE_CASE___( LGLSXP  , __FUN__ , __TMP__ ,
> __RCPPTYPE__ )                    \
>                 ___RCPP_HANDLE_CASE___( CPLXSXP , __FUN__ , __TMP__ ,
> __RCPPTYPE__ )                    \
>                 ___RCPP_HANDLE_CASE___( STRSXP  , __FUN__ , __TMP__ ,
> __RCPPTYPE__ )                    \
>                 ___RCPP_HANDLE_CASE___( VECSXP  , __FUN__ , __TMP__ ,
> __RCPPTYPE__ )                    \
>                 ___RCPP_HANDLE_CASE___( EXPRSXP , __FUN__ , __TMP__ ,
> __RCPPTYPE__ )                    \
>         default:
>
>                  \
>                 throw std::range_error( "not a vector" ) ;
>                                                      \
>         }
>
> #define RCPP_RETURN_VECTOR( _FUN_, _SEXP_ )  ___RCPP_RETURN___( _FUN_,
> _SEXP_ , Vector )
> #define RCPP_RETURN_MATRIX( _FUN_, _SEXP_ )  ___RCPP_RETURN___( _FUN_,
> _SEXP_ , Matrix )
>
>
>
> Romain
>

<snip>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.r-forge.r-project.org/pipermail/rcpp-devel/attachments/20130220/9157e38a/attachment-0001.html>