Merge pull request #397 from RcppCore/feature/issue383

Feature/issue383 -- closes #383

Author: eddelbuettel

ChangeLog

@@ -1,12 +1,38 @@
+2015-11-11  Dirk Eddelbuettel  <edd@debian.org>
+
+        * inst/include/Rcpp/vector/Matrix.h: Further simplification
+
 2015-11-11  Qiang Kou <qkou@umail.iu.edu>
 
         * include/Rcpp/complex.h: operator<< for Rcomplex
 
+2015-11-10  Dirk Eddelbuettel  <edd@debian.org>
+
+        * inst/include/Rcpp/vector/Matrix.h: Added transpose for character
+        matrices as well
+
+        * inst/unitTests/runit.Matrix.R: New unit tests
+        * inst/unitTests/cpp/Matrix.cpp: Ditto
+
+2015-11-08  Dirk Eddelbuettel  <edd@debian.org>
+
+        * inst/include/Rcpp/vector/Matrix.h: Matrix transpose is now a free
+        function for both INTSXP and REALSXP
+
+        * inst/unitTests/runit.Matrix.R: New unit tests
+        * inst/unitTests/cpp/Matrix.cpp: Ditto
+
 2015-11-08  Daniel C. Dillon  <dcdillon@gmail.com>
 
         * inst/include/Rcpp/Nullable.h: No longer prevent assignment of
         R_NilValue to Nullable<> in function signatures
 
+        * inst/include/Rcpp/vector/Matrix.h: Use showpoint in operator<<()
+
+2015-11-07  Dirk Eddelbuettel  <edd@debian.org>
+
+        * inst/include/Rcpp/vector/Matrix.h: Beginnings of a Matrix transpose
+
 2015-11-06  Kevin Ushey <kevinushey@gmailcom>
 
         * inst/include/Rcpp/vector/Subsetter.h: Add sugar math operators

inst/NEWS.Rd

@@ -15,8 +15,12 @@
       by Tianqi, fixing \ghit{380})
       \item An overflow in Matrix column indexing was corrected (PR \ghpr{390}
       by Qiang, fixing a bug reported by Allessandro on the list)
+      \item Matrix classes now have a \code{transpose()} function (fixing
+      \ghit{383}) 
       \item \code{Nullable} types can now be assigned \code{R_NilValue} in
       function signatures. (PR \ghpr{395} by Dan, fixing issue \ghit{394})
+      \item \code{operator<<()} now always shows decimal points (PR \ghpr{396}
+      by Dan) 
     }
     \item Changes in Rcpp Attributes:
     \itemize{

inst/include/Rcpp/vector/Matrix.h

@@ -2,7 +2,7 @@
 //
 // Matrix.h: Rcpp R/C++ interface class library -- matrices
 //
-// Copyright (C) 2010 - 2014 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2010 - 2015  Dirk Eddelbuettel and Romain Francois
 //
 // This file is part of Rcpp.
 //
@@ -161,7 +161,6 @@ class Matrix : public Vector<RTYPE, StoragePolicy>, public MatrixBase<RTYPE, tru
       return Sub( const_cast<Matrix&>(*this), row_range, Range(0,ncol()-1) ) ;
     }
 
-
 private:
     inline R_xlen_t offset(const int i, const int j) const { return i + static_cast<R_xlen_t>(nrows) * j ; }
 
@@ -361,6 +360,50 @@ inline std::ostream &operator<<(std::ostream & s, const Matrix<RTYPE, StoragePol
     return s;
 }
 
+template<int RTYPE, template <class> class StoragePolicy >
+Matrix<RTYPE, StoragePolicy> tranpose_impl(const Matrix<RTYPE, StoragePolicy> & x) {
+    typedef Matrix<RTYPE, StoragePolicy> MATRIX;
+    typedef Vector<RTYPE, StoragePolicy> VECTOR;
+
+    Vector<INTSXP, StoragePolicy> dims = ::Rf_getAttrib(x, R_DimSymbol);
+    int nrow = dims[0], ncol = dims[1];
+    MATRIX r(Dimension(ncol, nrow)); 	// new Matrix with reversed dimension
+    R_xlen_t len = XLENGTH(x), len2 = XLENGTH(x)-1;
+
+    // similar approach as in R: fill by in column, "accessing row-wise"
+    VECTOR s = VECTOR(r.get__());
+    for (R_xlen_t i = 0, j = 0; i < len; i++, j += nrow) {
+        if (j > len2) j -= len2;
+        s[i] = x[j];
+    }
+
+    // there must be a simpler, more C++-ish way for this ...
+    SEXP dimNames = Rf_getAttrib(x, R_DimNamesSymbol);
+    if (!Rf_isNull(dimNames)) {
+        // do we need dimnamesnames ?
+        Shield<SEXP> newDimNames(Rf_allocVector(VECSXP, 2));
+        SET_VECTOR_ELT(newDimNames, 0, VECTOR_ELT(dimNames, 1));
+        SET_VECTOR_ELT(newDimNames, 1, VECTOR_ELT(dimNames, 0));
+        Rf_setAttrib(r, R_DimNamesSymbol, newDimNames);
+    }
+    return r;
+}
+
+template<template <class> class StoragePolicy>
+Matrix<REALSXP, StoragePolicy> transpose(const Matrix<REALSXP, StoragePolicy> & x) {
+    return tranpose_impl<REALSXP, StoragePolicy>(x);
+}
+
+template<template <class> class StoragePolicy>
+Matrix<INTSXP, StoragePolicy> transpose(const Matrix<INTSXP, StoragePolicy> & x) {
+    return tranpose_impl<INTSXP, StoragePolicy>(x);
+}
+
+template<template <class> class StoragePolicy>
+Matrix<STRSXP, StoragePolicy> transpose(const Matrix<STRSXP, StoragePolicy> & x) {
+    return tranpose_impl<STRSXP, StoragePolicy>(x);
+}
+
 }
 
 #endif

inst/unitTests/cpp/Matrix.cpp

@@ -242,3 +242,19 @@ NumericVector runit_const_Matrix_column( const NumericMatrix& m ){
 int mat_access_with_bounds_checking(const IntegerMatrix m, int i, int j) {
     return m.at(i, j);
 }
+
+
+// [[Rcpp::export]]
+IntegerMatrix transposeInteger(const IntegerMatrix & x) {
+    return transpose(x);
+}
+
+// [[Rcpp::export]]
+NumericMatrix transposeNumeric(const NumericMatrix & x) {
+    return transpose(x);
+}
+
+// [[Rcpp::export]]
+CharacterMatrix transposeCharacter(const CharacterMatrix & x) {
+    return transpose(x);
+}

inst/unitTests/runit.Matrix.R

@@ -183,4 +183,31 @@ if (.runThisTest) {
         checkException(mat_access_with_bounds_checking(m, -1, -1) , msg = "index out of bounds not detected" )
     }
 
+    test.IntegerMatrix.transpose <- function() {
+        M <- matrix(1:12, 3, 4)
+        checkEquals(transposeInteger(M), t(M), msg="integer transpose")
+        rownames(M) <- letters[1:nrow(M)]
+        checkEquals(transposeInteger(M), t(M), msg="integer transpose with rownames")
+        colnames(M) <- LETTERS[1:ncol(M)]
+        checkEquals(transposeInteger(M), t(M), msg="integer transpose with row and colnames")
+    }
+
+    test.NumericMatrix.transpose <- function() {
+        M <- matrix(1.0 * (1:12), 3, 4)
+        checkEquals(transposeNumeric(M), t(M), msg="numeric transpose")
+        rownames(M) <- letters[1:nrow(M)]
+        checkEquals(transposeNumeric(M), t(M), msg="numeric transpose with rownames")
+        colnames(M) <- LETTERS[1:ncol(M)]
+        checkEquals(transposeNumeric(M), t(M), msg="numeric transpose with row and colnames")
+    }
+
+    test.CharacterMatrix.transpose <- function() {
+        M <- matrix(as.character(1:12), 3, 4)
+        checkEquals(transposeCharacter(M), t(M), msg="character transpose")
+        rownames(M) <- letters[1:nrow(M)]
+        checkEquals(transposeCharacter(M), t(M), msg="character transpose with rownames")
+        colnames(M) <- LETTERS[1:ncol(M)]
+        checkEquals(transposeCharacter(M), t(M), msg="character transpose with row and colnames")
+    }
+    
 }