Proxies for DimNames, allowing e.g. rownames(x) = ...

Author: kevinushey

ChangeLog

@@ -1,3 +1,10 @@
+2014-07-14  Kevin Ushey  <kevinushey@gmail.com>
+
+        * inst/unitTests/runit.Matrix.R: DimNames Proxy
+        * inst/unitTests/cpp/Matrix.cpp: Idem
+        * inst/include/Rcpp/vector/Matrix.h: Idem
+        * inst/include/Rcpp/vector/DimNameProxy.h: Idem
+
 2014-07-12  Dirk Eddelbuettel  <edd@debian.org>
 
         * inst/include/Rcpp/generated/InternalFunction__ctors.h: Regenerated

inst/include/Rcpp/Vector.h

@@ -50,6 +50,9 @@ namespace Rcpp{
 #include <Rcpp/vector/Vector.h>
 #include <Rcpp/vector/proxy.h>
 #include <Rcpp/vector/traits.h>
+
+#include <Rcpp/vector/DimNameProxy.h>
+
 #include <Rcpp/vector/Matrix.h>
 #include <Rcpp/vector/SubMatrix.h>
 #include <Rcpp/vector/MatrixRow.h>

inst/include/Rcpp/vector/DimNameProxy.h

@@ -0,0 +1,84 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// DimNameProxy.h: Rcpp R/C++ interface class library -- dimension name proxy
+//
+// Copyright (C) 2010 - 2014 Dirk Eddelbuettel, Romain Francois and Kevin Ushey
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_vector_DimNameProxy_h
+#define Rcpp_vector_DimNameProxy_h
+
+namespace Rcpp{
+namespace internal{
+
+    class DimNameProxy {
+
+    public:
+
+        DimNameProxy(SEXP data, int dim): data_(data), dim_(dim) {}
+        DimNameProxy(DimNameProxy const& other):
+            data_(other.data_), dim_(other.dim_) {}
+
+        inline DimNameProxy& operator=(SEXP other) {
+            SEXP dim = Rf_getAttrib(data_, R_DimSymbol);
+            if (INTEGER(dim)[dim_] != Rf_length(other)) {
+                std::stringstream s;
+                s << "dimension extent is '"
+                  << INTEGER(dim)[dim_]
+                  << "' while length of names is '"
+                  << Rf_length(other)
+                  << "'";
+                stop(s.str());
+            }
+            SEXP dimnames = Rf_getAttrib(data_, R_DimNamesSymbol);
+            SEXP dims = Rf_getAttrib(data_, R_DimSymbol);
+            if (Rf_isNull(dimnames)) {
+                Shield<SEXP> new_dimnames(Rf_allocVector(VECSXP, Rf_length(dims)));
+                SET_VECTOR_ELT(new_dimnames, dim_, other);
+                Rf_setAttrib(data_, R_DimNamesSymbol, new_dimnames);
+            } else {
+                SET_VECTOR_ELT(dimnames, dim_, other);
+            }
+            return *this;
+        }
+
+        inline operator SEXP() const {
+            SEXP dimnames = Rf_getAttrib(data_, R_DimNamesSymbol);
+            return Rf_isNull(dimnames) ? (R_NilValue) : (VECTOR_ELT(dimnames, dim_));
+        }
+
+        template <typename T>
+        inline operator T() const {
+            SEXP dimnames = Rf_getAttrib(data_, R_DimNamesSymbol);
+            if (Rf_isNull(dimnames)) {
+                return T();
+            } else {
+                return T(VECTOR_ELT(dimnames, dim_));
+            }
+        }
+
+    private:
+
+        SEXP data_;
+        int dim_;
+    };
+
+}
+
+}
+
+#endif

inst/include/Rcpp/vector/Matrix.h

@@ -188,7 +188,15 @@ class Matrix : public Vector<RTYPE, StoragePolicy>, public MatrixBase<RTYPE, tru
         }
     }
 
-} ;
+};
+
+inline internal::DimNameProxy rownames(SEXP x) {
+    return internal::DimNameProxy(x, 0);
+}
+
+inline internal::DimNameProxy colnames(SEXP x) {
+    return internal::DimNameProxy(x, 1);
+}
 
 }
 

inst/unitTests/cpp/Matrix.cpp

@@ -205,3 +205,9 @@ NumericMatrix runit_SubMatrix( ){
     return res;
 }
 
+// [[Rcpp::export]]
+void runit_rownames_colnames_proxy(
+    NumericMatrix x, CharacterVector row_names, CharacterVector col_names) {
+    rownames(x) = row_names;
+    colnames(x) = col_names;
+}

inst/unitTests/runit.Matrix.R

@@ -146,5 +146,14 @@ if (.runThisTest) {
         checkEquals(m, matrix_opequals(m))
     }
 
+    test.NumericMatrix.rownames.colnames.proxy <- function() {
+        m <- matrix(as.numeric(1:4), nrow = 2)
+        runit_rownames_colnames_proxy(m, letters[1:2], LETTERS[1:2])
+        checkEquals(rownames(m), letters[1:2])
+        checkEquals(colnames(m), LETTERS[1:2])
+        checkException(runit_rownames_colnames_proxy(m, letters[1:3], letters[1:3]))
+        checkException(runit_rownames_colnames_proxy(m, letters[1:2], NULL))
+    } 
+
 
 }