[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