[Rcpp-commits] r3462 - in pkg/RcppEigen/inst: include unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Feb 3 17:48:02 CET 2012
Author: dmbates
Date: 2012-02-03 17:48:02 +0100 (Fri, 03 Feb 2012)
New Revision: 3462
Modified:
pkg/RcppEigen/inst/include/RcppEigenWrap.h
pkg/RcppEigen/inst/unitTests/runit.sparse.R
Log:
Allow import of compressed row sparse matrices. Add test of same.
Modified: pkg/RcppEigen/inst/include/RcppEigenWrap.h
===================================================================
--- pkg/RcppEigen/inst/include/RcppEigenWrap.h 2012-02-03 14:29:31 UTC (rev 3461)
+++ pkg/RcppEigen/inst/include/RcppEigenWrap.h 2012-02-03 16:48:02 UTC (rev 3462)
@@ -93,6 +93,9 @@
SEXP eigen_wrap_plain_dense( const T& object, Rcpp::traits::false_type ){
typedef typename T::Scalar Scalar;
const int RTYPE = Rcpp::traits::r_sexptype_traits<Scalar>::rtype;
+ if ( RTYPE != REALSXP ) {
+ throw std::invalid_argument("No sparse matrix for types other than REALSXP implemented in R.");
+ }
const int nnz = object.nonZeros();
S4 ans(T::IsRowMajor ? "dgRMatrix" : "dgCMatrix");
ans.slot("Dim") = Dimension(object.rows(), object.cols());
@@ -250,7 +253,37 @@
T* d_start;
IntegerVector d_dims, d_i, d_p;
};
-
+
+ template<typename T>
+ class Exporter<Eigen::SparseMatrix<T, Eigen::RowMajor> > {
+ public:
+ Exporter(SEXP x)
+ : d_x(x), d_dims(d_x.slot("Dim")), d_j(d_x.slot("j")), d_p(d_x.slot("p")) {
+ if (!d_x.is("dgRMatrix"))
+ throw std::invalid_argument("Need S4 class dgRMatrix for a sparse matrix");
+ const int RTYPE = ::Rcpp::traits::r_sexptype_traits<T>::rtype ;
+ SEXP xx = d_x.slot("x");
+ if (TYPEOF(xx) != RTYPE) // should coerce instead - see Rcpp/inst/include/Rcpp/internal/export.h
+ throw std::invalid_argument("Wrong R type for sparse matrix");
+ typedef typename ::Rcpp::traits::storage_type<RTYPE>::type STORAGE;
+ d_start = ::Rcpp::internal::r_vector_start<RTYPE,STORAGE>(xx);
+ }
+ Eigen::SparseMatrix<T, Eigen::RowMajor> get() {
+ Eigen::SparseMatrix<T, Eigen::RowMajor> ans(d_dims[0], d_dims[1]);
+ ans.reserve(d_p[d_dims[0]]);
+ for(int i = 0; i < d_dims[0]; ++i) {
+ ans.startVec(i);
+ for (int k = d_p[i]; k < d_p[i + 1]; ++k) ans.insertBack(i, d_j[k]) = d_start[k];
+ }
+ ans.finalize();
+ return ans;
+ }
+ protected:
+ S4 d_x;
+ T* d_start;
+ IntegerVector d_dims, d_j, d_p;
+ };
+
} // namespace traits
}
Modified: pkg/RcppEigen/inst/unitTests/runit.sparse.R
===================================================================
--- pkg/RcppEigen/inst/unitTests/runit.sparse.R 2012-02-03 14:29:31 UTC (rev 3461)
+++ pkg/RcppEigen/inst/unitTests/runit.sparse.R 2012-02-03 16:48:02 UTC (rev 3462)
@@ -21,7 +21,7 @@
suppressMessages(require(inline))
}
-test.wrapSparse.R <- function(){
+test.wrapSparse.double.R <- function(){
fx <- cxxfunction( , '
@@ -39,9 +39,120 @@
res <- fx()
rr <- Matrix::t(as(gl(3,3), "sparseMatrix"))
colnames(rr) <- NULL
- checkEquals( res, rr, msg = "Sparsematrix wrap")
+ checkEquals( res, rr, msg = "wrap<SparseMatrix<double> >")
}
+test.wrapSparse.double.ColMajor.R <- function(){
+
+ fx <- cxxfunction( , '
+
+ Eigen::SparseMatrix<double, Eigen::ColMajor> mm(9,3);
+ mm.reserve(9);
+ for (int j = 0; j < 3; ++j) {
+ mm.startVec(j);
+ for (int i = 3 * j; i < 3 * (j + 1); ++i)
+ mm.insertBack(i, j) = 1.;
+ }
+ mm.finalize();
+ return wrap(mm);
+' , plugin = "RcppEigen" )
+
+ res <- fx()
+ rr <- Matrix::t(as(gl(3,3), "sparseMatrix"))
+ colnames(rr) <- NULL
+ checkEquals( res, rr, msg = "wrap<SparseMatrix<double, Eigen::ColMajor> >")
+}
+
+test.wrapSparse.int.ColMajor.R <- function(){
+
+ fx <- cxxfunction( , '
+
+ Eigen::SparseMatrix<int, Eigen::ColMajor> mm(9,3);
+ mm.reserve(9);
+ for (int j = 0; j < 3; ++j) {
+ mm.startVec(j);
+ for (int i = 3 * j; i < 3 * (j + 1); ++i)
+ mm.insertBack(i, j) = 1;
+ }
+ mm.finalize();
+ return wrap(mm);
+' , plugin = "RcppEigen" )
+
+ #res <- fx()
+ #rr <- Matrix::t(as(gl(3,3), "sparseMatrix"))
+ #colnames(rr) <- NULL
+ #checkEquals( res, rr, msg = "wrap<SparseMatrix<double, Eigen::ColMajor> >")
+ checkException( fx(), msg = "wrap<SparseMatrix<int, Eigen::ColMajor> >" )
+}
+
+test.wrapSparse.double.RowMajor.R <- function(){
+
+ fx <- cxxfunction( , '
+
+ Eigen::SparseMatrix<double, Eigen::RowMajor> mm(9,3);
+ mm.reserve(9);
+ for (int irow = 0; irow < 9; ++irow) {
+ mm.startVec(irow);
+ mm.insertBack(irow, irow / 3) = static_cast<double>( 9 - irow );
+ }
+ mm.finalize();
+ return wrap(mm);
+' , plugin = "RcppEigen" )
+
+ res <- fx()
+ rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) )
+ colnames(rr) <- NULL
+ checkEquals( res, rr, msg = "wrap<SparseMatrix<double, Eigen::RowMajor> >")
+}
+
+test.wrapSparse.int.RowMajor.R <- function(){
+
+ fx <- cxxfunction( , '
+
+ Eigen::SparseMatrix<int, Eigen::RowMajor> mm(9,3);
+ mm.reserve(9);
+ for (int irow = 0; irow < 9; ++irow) {
+ mm.startVec(irow);
+ mm.insertBack(irow, irow / 3) = 9 - irow;
+ }
+ mm.finalize();
+ return wrap(mm);
+' , plugin = "RcppEigen" )
+
+ #res <- fx()
+ #rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=9L:1L, Dim=c(9L,3L) )
+ #colnames(rr) <- NULL
+ #checkEquals( res, rr, msg = "wrap<SparseMatrix<int, Eigen::RowMajor> >")
+ checkException( fx(), msg = "wrap<SparseMatrix<int, Eigen::RowMajor> >" )
+}
+
+test.asSparse.double.ColMajor.R <- function(){
+
+ fx <- cxxfunction( sig=signature(R_mm="dgCMatrix"), '
+
+ Eigen::SparseMatrix<double, Eigen::ColMajor> mm = Rcpp::as<Eigen::SparseMatrix<double, Eigen::ColMajor> >( R_mm );
+ return wrap(mm);
+' , plugin = "RcppEigen" )
+
+ rr <- Matrix::t(as(gl(3,3), "sparseMatrix"))
+ colnames(rr) <- NULL
+ res <- fx( R_mm = rr )
+ checkEquals( res, rr, msg = "as<SparseMatrix<double, Eigen::ColMajor> >")
+}
+
+test.asSparse.double.RowMajor.R <- function(){
+ fx <- cxxfunction( sig=signature(R_mm="dgRMatrix"), '
+
+ Eigen::SparseMatrix<double, Eigen::RowMajor> mm = Rcpp::as<Eigen::SparseMatrix<double, Eigen::RowMajor> >( R_mm );
+ return wrap(mm);
+' , plugin = "RcppEigen" )
+
+ rr <- new( "dgRMatrix", j=rep(0L:2L, each=3), p=0L:9L, x=as.numeric(9:1), Dim=c(9L,3L) )
+ colnames(rr) <- NULL
+ res <- fx( R_mm = rr )
+ checkEquals( res, rr, msg = "as<SparseMatrix<double, Eigen::RowMajor> >")
+}
+
test.solveCholmod.R <- function() {
suppressMessages(require("Matrix", character.only=TRUE))
data("KNex", package = "Matrix")
More information about the Rcpp-commits
mailing list