[Rcpp-devel] RFC -- Function for making modules ala inline
Christian Gunning
xian at unm.edu
Sat Mar 19 03:44:08 CET 2011
On Fri, Mar 18, 2011 at 5:34 AM, Dirk Eddelbuettel <edd at debian.org> wrote:
>
> Christian,
>
> Thanks for (re-)posting this. Do you have an example use with an example
> module, or maybe with one of the unit tests?
Not the most minimal example, but it should give you some idea...
## begin example
mm1= matrix(1:40, ncol=10) +0.001;
mm2= matrix(1:20, ncol=10) +0.001
require(inline)
source('modfunction.R.txt');
dd3 = modfunction('mdist', 'Dist.cpp.txt', plugin='Rcpp', verbose=F)
dtest = new(dd3$Dist, mm1, mm2)
tt = list()
tt$d2 = ( (dtest$dist( 2)[,1]) - as.matrix(dist(rbind(mm2[1,], mm1)))[-1,1])
tt$d1 = ( dtest$dist( 1)[,1] - as.matrix(dist(rbind(mm2[1,], mm1),
method='minkowski', p=1))[-1,1])
print(tt)
I have one question about the intended behavior of object persistence
here -- i.e. if i quit, save session, restart session, I can cause a
segfault with:
dtest = new(dd3$Dist, mm1, mm2)
Does this indicate that I'm missing an on.exit() somewhere?
>
> When I started with RcppBDT I did use cxxfunction() via its include=txt
> argument but I haven't done much that way. I won't have a lot of time poking
> around to see if this could / should be made better but I'll try to play with
> it.
includes=txt gives the user a way to add *more* code to the body. As
I see it, the salient issue here is that a module doesn't need any of
the "function wrapper" code, and doesn't return a function. This is
why it's almost a proper subset of cxxfunction.
> Not sure about the natural place for it. Some part of me sees it as an
> extension / variant of cxxfunction -- which already has a weak dependency on
> Rcpp via the plugin call.
One thought is cxxfunction(plugin="RcppModule") -- a simple
if(plugin==) in cxxfunction. Then (i think) minimal modification
would be required:
code <- sprintf('//no function defs \n\n %s ', modulecode)
and
dyn.load(libLFile)
retmod <- Module(modname, PACKAGE=f)
return(retmod)
I'll try to look at this more, too, just wanted some confirmation that
I'm headed in a reasonable direction :)
-xian
-------------- next part --------------
using namespace Rcpp;
class Dist {
public:
Dist( NumericMatrix data_, NumericMatrix query_):
// data matrix of obs by row, query is a matrix of "row-obs"
data(data_), nr(data_.nrow()), nc(data_.ncol()) {
// add query and check that dimensions match
set_query(query_);
}
// only data is public (and is constant)
const NumericMatrix data;
NumericMatrix dist( double L_ ) {
NumericMatrix ret(nr, nrq); // one row per data obs, one col per query obs
L = L_;
for ( int rd=0; rd < nr; rd++) {
for ( int rq=0; rq<nrq; rq++) {
ret(rd, rq) = distfun(rd, rq);
}
};
return ret;
}
// query get/set
NumericMatrix get_query() { return query;}
void set_query(NumericMatrix query_) {
query = query_;
nrq = query.nrow(); // # of query obs
if (nc != query.ncol() ) throw std::length_error("Number of columns of data and query must match");
}
private:
const int nr, nc; // dimensions of data
int nrq; // dimensions of query, can vary
double L; // L-norm dimension
NumericMatrix query;
// dist for these rows of data and query
double distfun(int rd, int rq) {
double ret = 0;
for (int cc = 0; cc < nc; cc++) { // column is "dimension"
ret += pow ( fabs(
data( rd, cc) - query( rq, cc)
), L);
}
ret = pow( ret, (1.0/L));
//return pow( ret, (1.0/L) );
return ret;
}
};
RCPP_MODULE(mdist) {
/* R usage:
Dist <- Module("mdist")
newdist <- new( Dist, matrix(1:100, ncol=10), matrix(1:20, ncol=10))
newdist$dist(2) ## Euclidean distance
show(newdist$dist) ## introspect
*/
class_<Dist>("Dist")
.constructor<NumericMatrix, NumericMatrix>("\n USAGE: \n\t newdist <- new( Dist, matrix(1:100, ncol=10), matrix(1:20, ncol=10)) \n -- Number of columns must match.")
.field_readonly("data", &Dist::data, "Data is read-only. Number of columns must match for data and query")
.property("query", &Dist::get_query, &Dist::set_query, "Query can be modified. Number of columns must match for data and query")
.method("dist", &Dist::dist, "e.g. mydist$dist( 2 ); -- Euclidean distance")
;
}
More information about the Rcpp-devel
mailing list