Search code examples
rtype-conversionrcppcoerciontype-coercion

Access "natural coercion" logic from C/C++ code


When calling unlist or c, the type will be promoted to the smallest type capable of representing everything:

> c(as.integer(1), 2.3, '3')
[1] "1"   "2.3" "3"  
> c(TRUE, 5)
[1] 1 5
> unlist(list(as.integer(1:5), as.complex(2:4)))
[1] 1+0i 2+0i 3+0i 4+0i 5+0i 2+0i 3+0i 4+0i

How can I access this logic from C/C++ code?

I have looked for the C sources of c and unlist and found the following code in both do_c_dflt and do_unlist (main/bind.c):

if (data.ans_flags & 512)      mode = EXPRSXP;
else if (data.ans_flags & 256) mode = VECSXP;
else if (data.ans_flags & 128) mode = STRSXP;
else if (data.ans_flags &  64) mode = CPLXSXP;
else if (data.ans_flags &  32) mode = REALSXP;
else if (data.ans_flags &  16) mode = INTSXP;
else if (data.ans_flags &   2) mode = LGLSXP;
else if (data.ans_flags &   1) mode = RAWSXP;

The variable data, which is of type BindData, is computed by a routine AnswerType that seems to define the coercion logic. However, the type BindData is declared in bind.c only.

So: Is R's general coercion logic exported anywhere, or am I bound to copy-paste the code from bind.c? (Sorry for the pun...)


Solution

  • Kevin just posted an article on the Rcpp Gallery which is pretty close in spirit, it tests explicitly using the macros from R's API:

    #include <Rcpp.h>
    using namespace Rcpp;
    
    // [[Rcpp::export]]
    List do_stuff( List x_ ) {
        List x = clone(x_);
        for( List::iterator it = x.begin(); it != x.end(); ++it ) {
            switch( TYPEOF(*it) ) {
                case REALSXP: {
                    NumericVector tmp = as<NumericVector>(*it);
                    tmp = tmp * 2;
                    break;    
                }
                case INTSXP: {
                    if( Rf_isFactor(*it) ) break; // factors have type INTSXP too
                    IntegerVector tmp = as<IntegerVector>(*it);
                    tmp = tmp + 1;
                    break;
                }
                default: {
                    stop("incompatible SEXP encountered;");
                }
           }
      }  
      return x;
    }