<font face="courier new, monospace">Hi all.<br><br>I've been doing some testing on how to get arbitrary precision numbers out of c++ and into R. The following example inline Rcpp code generates an RcppMpfr cxxfunction plugin for wrapping <mpreal> to the Rmpfr S4 "mpfr1" object. There are local include paths that need adjusting (for now) to your environment, and the mpreal header only c++ wrapper for mpfr ( <a href="http://www.holoborodko.com/pavel/mpfr/">http://www.holoborodko.com/pavel/mpfr/</a> ). I'll be making this into a package but wanted to ask about how to do something first...<br>
<br>Rmpfr defines 'mpfr1' and 'mpfr' where 'mpfr' is usable within R and is a list type containing 'mpfr1' objects. So the Rcpp::wrap is setup to get and populate an S4 "mpfr1" object, but to be usable on the R side the S4 "mpfr" needs to be used. I can get and populate the ".Data" field in the mpfr::mpreal wrapper using Rcpp::List but was wondering if the Rcpp::wrap could be setup to capture an S4 class type.<br>
<br>BTW:: The timing comparison shows a huge performance gain (the R_mpfr_fac call returns an mpfr1 object only and speed is comparable but slightly slower then using Rcpp to do the same) ::<br><br></font><div><font face="courier new, monospace"><div>
test elapsed relative</div><div>5 factorial(93) 0.05 1.0</div><div>6 .Call(Rmpfr:::R_mpfr_fac, 93, 255) 0.08 1.6</div>
<div>2 mpreal_factorial(93, 255) 0.20 4.0</div><div>4 new("mpfr", .Call(Rmpfr:::R_mpfr_fac, 93, 255)) 2.14 42.8</div><div>3 Rmpfr::factorialMpfr(93, 255) 2.37 47.4</div>
<div>1 factorial(mpfr(93, 255)) 13.26 265.2</div></font></div><font face="courier new, monospace">--</font><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">I'd like to have wrap<mpfr::mpreal> wrap to an 'mpfr1' and wrap<S4<mpfr1>> (imagined def) wrap to an mpfr list.</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"><div>suppressMessages( require( inline) )</div><div>suppressMessages( require( Rcpp ) )</div><div>suppressMessages( require( Rmpfr ))</div>
<div><br></div><div>#### Plugin Setup ####</div><div># For Rcpp wrapping.</div><div><br></div><div>include.before <- '</div><div>#include <cmath></div><div>#include <Iterator></div><div>#include <RcppCommon.h></div>
<div>#include <mpreal.h></div><div><br></div><div>namespace Rcpp {</div><div> template <> SEXP wrap( const mpfr::mpreal& ) ;</div><div>}</div><div>'</div><div><br></div><div>include.after <- '</div>
<div>// Definitions from Rmpfr conversion utilities.</div><div>#if GMP_NUMB_BITS == 32</div><div><br></div><div># define R_mpfr_nr_ints nr_limbs</div><div># define R_mpfr_exp_size 1</div><div><br></div><div>#elif GMP_NUMB_BITS == 64</div>
<div><br></div><div># define R_mpfr_nr_ints (2*nr_limbs)</div><div># define R_mpfr_exp_size 2</div><div><br></div><div>#endif</div><div><br></div><div># define RIGHT_HALF(_LONG_) ((long long)(_LONG_) & 0x00000000FFFFFFFF)</div>
<div># define LEFT_SHIFT(_LONG_) (((long long)(_LONG_)) << 32)</div><div><br></div><div>namespace Rcpp {</div><div><br></div><div> template<> SEXP wrap( const mpfr::mpreal& v )</div><div> {</div><div> mpfr_srcptr pv( v.mpfr_srcptr() );</div>
<div><br></div><div> S4 vS4("mpfr1");</div><div> vS4.slot("prec") = wrap( (int)pv->_mpfr_prec );</div><div> vS4.slot("sign") = wrap( (int)pv->_mpfr_sign);</div><div><br></div><div>
IntegerVector d( std::ceil( (double)pv->_mpfr_prec / (double)mp_bits_per_limb ) );</div><div> mp_size_t i = 0;</div><div><br></div><div> if( GMP_NUMB_BITS == 32 ) {</div><div><br></div><div> vS4.slot("exp") = wrap( (int)pv->_mpfr_exp );</div>
<div><br></div><div> for( auto & e : d ) {</div><div> e = (int) pv->_mpfr_d[i];</div><div> ++i;</div><div> }</div><div><br></div><div> } else {</div><div><br></div><div> IntegerVector exp(2);</div>
<div> exp[0] = (int) RIGHT_HALF(pv->_mpfr_exp);</div><div> exp[1] = (int) (pv->_mpfr_exp >> 32);</div><div> vS4.slot("exp") = wrap( exp );</div><div><br></div><div> for(i=0; i < d.size(); i++) {</div>
<div> d[2*i] = (int) RIGHT_HALF(pv->_mpfr_d[i]);</div><div> d[2*i+1]= (int) (pv->_mpfr_d[i] >> 32);</div><div> }</div><div><br></div><div> }</div><div><br></div><div> vS4.slot("d") = wrap( d );</div>
<div><br></div><div> S4 ans("mpfr");</div><div> ans.slot(".Data") = List::create( wrap(vS4) );</div><div><br></div><div> return wrap( ans );</div><div> //return wrap( vS4 );</div><div> }</div>
<div><br></div><div>}</div><div>'</div><div><br></div><div>#### Plugin Definition ####</div><div>RcppMpfr <- function()</div><div>{</div><div> plugin <- Rcpp:::Rcpp.plugin.maker(</div><div> include.before= include.before,</div>
<div> include.after= include.after,</div><div> LinkingTo=c('Rmpfr',"Rcpp"),</div><div> libs="-Lc:/RtoolsLocal/R-2.15.0/lib/i386 -lmpfr -lgmp" )</div><div> settings <- plugin()</div>
<div> settings$env$PKG_CPPFLAGS=paste(</div><div> "-std=c++0x",</div><div> "-Ic:/users/almostautomated/src/RcppMpfr++/mpreal/inst/include",</div><div> "-Ic:/RtoolsLocal/R-2.15.0/include" )</div>
<div> settings$env$PKG_CXXFLAGS="-IC:/Users/almostautomated/R/win-library/2.15/Rcpp/include"</div><div> </div><div> settings </div><div>}</div><div><br></div><div>registerPlugin(name="RcppMpfr", plugin=RcppMpfr )</div>
<div><br></div><div><br></div><div>#### Sample Function Setup ####</div><div>headers <- '</div><div>#include <iostream></div><div>'</div><div><br></div><div>sources <- '</div><div> using namespace mpfr;</div>
<div> using namespace Rcpp;</div><div><br></div><div> mpreal::set_default_prec( as< unsigned long >( prec ) );</div><div> return wrap( fac_ui( as< double >( x ) ) );</div><div>'</div><div><br></div><div>
#### Sample Function Defintion ####</div><div>mpreal_factorial <-</div><div> cxxfunction( sig=signature(x='numeric', prec='numeric'),</div><div> includes=headers,</div><div> body=sources,</div>
<div> plugin="RcppMpfr",</div><div> verbose=FALSE)</div><div><br></div><div><br></div><div>#### Sample Function Benchmark ####</div><div>timings <-</div><div> benchmark( factorial( mpfr(93,255) ),</div>
<div> mpreal_factorial(93,255),</div><div> Rmpfr::factorialMpfr(93,255),</div><div> new("mpfr", .Call(Rmpfr:::R_mpfr_fac, 93, 255)),</div><div> factorial(93),</div><div> .Call(Rmpfr:::R_mpfr_fac, 93, 255),</div>
<div> replications=1000,</div><div> order="elapsed",</div><div> columns=c("test", "elapsed", "relative"))</div><div><br></div></font></div><div><font face="courier new, monospace"><br>
</font></div><div><span style="font-family:'courier new',monospace">Sincerely,</span><br></div><div><font face="courier new, monospace">Thell</font></div>