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);
// }