[Rcpp-devel] Bug with table sugar and NumericVector in Rcpp 0.10.3

[Dirk Eddelbuettel]

On 29 March 2013 at 09:40, Dirk Eddelbuettel wrote:
| 
| On 29 March 2013 at 15:24, romain at r-enthusiasts.com wrote:
| | Le 2013-03-29 14:31, Dirk Eddelbuettel a écrit :
| | > On 29 March 2013 at 09:11, romain at r-enthusiasts.com wrote:
| | > |
| | > | Hello,
| | > |
| | > | This is related to this change:
| | > |
| | > | 2013-01-15  Dirk Eddelbuettel  <edd at debian.org>
| | > |
| | > | 	* src/api.cpp (Rcpp): Commented-out coerce_to_string() for real 
| | > and
| | > | 	complex arguments as R-devel (as of today) dislikes use of non-API
| | > | 	functions Rf_EncodeComplex’, ‘Rf_EncodeReal’, ‘Rf_formatComplex’
| | > |
| | > | So maybe Dirk has a plan to fix it.
| | >
| | > I do not.
| | 
| | Fine. So I'll fix it.
| 
| Hold on. 
| 
| I am in the middle of it. I do have a poor replacementment for EncodeReal,
| and am about to test one for complex. Will post soon.
| 
| Am not covering scientific notation at this point.

Ok, here replacement candidates.  Kudos to Kevin for sending something
reproducible that triggered this.  This snipped below grew from his code and
provids replacement candidates for coerce_to_string() for the real and
complex cases, not using the internal R functions (which I also did not look
at).  Obviously the function headers need to change from the sample to what
api.cpp uses.

What we get is simple snprintf() calls which almost surely is less featureful
than what R has, but please complaon to R Core about the sillyness of us not
being able to use _existing and tested functions_.  It's painful.


Dirk

#include <Rcpp.h>

static const char* dropTrailing0(char *s, char cdec) {
    /* Note that  's'  is modified */
    char *p = s;
    for (p = s; *p; p++) {
      if(*p == cdec) {
        char *replace = p++;
	      while ('0' <= *p  &&  *p <= '9')
		      if(*(p++) != '0')
		        replace = p;
	        if(replace != p)
		        while((*(replace++) = *(p++)))
		           ;
	        break;  
	   }
    }
    return s;
}

//template <> 
// const char* coerce_to_string/*<REALSXP>*/(double x){
// [[Rcpp::export]]
const char* coerce_to_stringRE(double x){
    int w,d,e ;
    // cf src/main/format.c in R's sources:
    //   The return values are
    //     w : the required field width
    //     d : use %w.df in fixed format, %#w.de in scientific format
    //     e : use scientific format if != 0, value is number of exp digits - 1
    //
    //   nsmall specifies the minimum number of decimal digits in fixed format:
    //   it is 0 except when called from do_format.
    Rf_formatReal( &x, 1, &w, &d, &e, 0 ) ;
    // we are no longer allowed to use this:
    //     char* tmp = const_cast<char*>( Rf_EncodeReal(x, w, d, e, '.') );
    // so approximate it poorly as
    char tmp[128];
    snprintf(tmp, 127, "%*.*f", w, d, x);
    //Rcpp::Rcout << "Vec is " << vec << std::endl;
    return dropTrailing0(tmp, '.');
     
}

//template <> 
//const char* coerce_to_string/*<CPLXSXP>*/(Rcomplex x){
// [[Rcpp::export]]
std::string coerce_to_stringCP(Rcomplex x){
    int wr, dr, er, wi, di, ei;
    // cf src/main/format.c in R's sources:
    Rf_formatComplex(&x, 1, &wr, &dr, &er, &wi, &di, &ei, 0);
    //return Rf_EncodeComplex(x, wr, dr, er, wi, di, ei, '.' );

    // we are no longer allowed to use this:
    //     Rf_EncodeComplex(x, wr, dr, er, wi, di, ei, '.' );
    // so approximate it poorly as
    char tmp[128];
    snprintf(tmp, 127, "%*.*f+%*.*fi", wr, dr, x.r, wi, di, x.i);
    return std::string(tmp);  // force a copy
}

using namespace Rcpp;

// // [[Rcpp::export]]
// IntegerVector counts(NumericVector x) {
//  return table(x);
// }



-- 
Dirk Eddelbuettel | edd at debian.org | http://dirk.eddelbuettel.com