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

[romain at r-enthusiasts.com]

Cool. I'll have a look when I'm back from easter weekend.

Romain

Le 2013-03-29 16:00, Dirk Eddelbuettel a écrit :
> 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);
> // }