[Rcpp-devel] Defining wrap methods for C++ classes that have data members of Rcpp types

[Douglas Bates]

I'm again trying to define instances of the wrap template for C++
classes that have data members defined in Rcpp.h

A stand-alone example, which is rather lengthy, is enclosed.  In this
example I am unsuccessful in using the "intrusive" formulation
described in the "Extending Rcpp" vignette.  I will try again with the
"non-intrusive" formulation.  Other suggestions are welcome.

library(Matrix)
library(inline)
library(Rcpp)

incl <- '
#include <RcppCommon.h>

namespace Rcpp {
     template <int RTYPE> class Vector;
     template <int RTYPE> class Matrix;
     class S4;
     typedef Vector<REALSXP> NumericVector;
     typedef Vector<INTSXP>  IntegerVector;
     typedef Vector<VECSXP>  List;
     typedef Matrix<REALSXP> NumericMatrix;
}

class dtrMatrix {
protected:
    Rcpp::NumericVector d_dat;
    Rcpp::List d_dimnames;
    int d_size;			// must be square
    bool d_upper;		// true if upper triangular
    bool d_unit;		// true if unit diagonal
public:
    dtrMatrix(Rcpp::S4&) throw (std::runtime_error);
    operator SEXP();
};

#include <Rcpp.h>

dtrMatrix::dtrMatrix(Rcpp::S4& xp) throw (std::runtime_error)
    : d_dat(xp.slot("x")), d_dimnames(xp.slot("Dimnames")) {
    if (!xp.inherits("dtrMatrix"))
	throw std::runtime_error("constructor needs S4 class dtrMatrix");
    IntegerVector dd = xp.slot("Dim");
    if (dd.size() != 2 || dd[0] != dd[1])
	throw std::runtime_error("Matrix must be square");
    d_size = dd[0];
    std::string uplo = as<std::string>(xp.slot("uplo"));
    d_upper = (uplo == "U") || (uplo == "u");
    std::string diag = as<std::string>(xp.slot("diag"));
    d_unit = (diag == "U") || (diag == "u");
}

dtrMatrix::operator SEXP() {
    Rcpp::S4 ans("dtrMatrix");
    ans.slot("x") = clone(d_dat);
    ans.slot("Dimnames") = clone(d_dimnames);
    IntegerVector dd(2);
    dd[0] = dd[1] = d_size;
    ans.slot("Dim") = dd;
    ans.slot("uplo") = d_upper ? "U" : "L";
    ans.slot("diag") = d_unit ? "U" : "N";
    return ans;
}
'

code <- '
dtrMatrix x(S4(x_));
return wrap(x);
'
ff <- cxxfunction(signature(x_ = "ANY"), code, incl, plugin="Rcpp")

example("dtrMatrix-class")
ff(T)