Implement push_back and push_front for DataFrame.

This explicitly defines push_back and push_back methods for DataFrame
which copies row.names and class attributes from the original object.

This fixes #1094 where these operations converted the object to a list.

Tests for this behavior are also implemented.

Author: waltersom

ChangeLog

@@ -17,6 +17,13 @@
         * inst/NEWS.Rd: Idem
         * vignettes/rmd/Rcpp.bib: Idem
         * inst/bib/Rcpp.bib: Idem
+2020-07-01 Walter Somerville <[email protected]>
+	
+	* inst/include/Rcpp/DataFrame.h: Implement explict push_back and
+	push_front for DataFrame, which takes care to set the class and
+	row.names attributes.
+	* inst/tinyTest/test_dataframe.R Add in tests for push_back/push_front
+	* inst/tinyTest/cpp/DataFrame.cpp
 
 2020-06-27  Dirk Eddelbuettel  <[email protected]>
 

inst/include/Rcpp/DataFrame.h

@@ -83,6 +83,42 @@ namespace Rcpp{
             return LENGTH(rn);
         }
 
+	template <typename T>
+        void push_back( const T& object){
+            R_xlen_t NewSize = std::max(object.size(), static_cast<R_xlen_t>(nrow()));
+            Parent::push_back(object);
+            IntegerVector RowNames = Range(1, NewSize);
+            Rf_setAttrib(Parent::get__(), R_RowNamesSymbol, RowNames);
+            Rf_setAttrib(Parent::get__(), R_ClassSymbol, Rf_mkString("data.frame"));
+        }
+
+        template <typename T>
+        void push_back( const T& object, const std::string& name ){
+            R_xlen_t NewSize = std::max(object.size(), static_cast<R_xlen_t>(nrow()));
+            Parent::push_back(object, name);
+            IntegerVector RowNames = Range(1, NewSize);
+            Rf_setAttrib(Parent::get__(), R_RowNamesSymbol, RowNames);
+            Rf_setAttrib(Parent::get__(), R_ClassSymbol, Rf_mkString("data.frame"));
+        }
+
+        template <typename T>
+        void push_front( const T& object){
+            R_xlen_t NewSize = std::max(object.size(), static_cast<R_xlen_t>(nrow()));
+            Parent::push_front(object);
+            IntegerVector RowNames = Range(1, NewSize);
+            Rf_setAttrib(Parent::get__(), R_RowNamesSymbol, RowNames);
+            Rf_setAttrib(Parent::get__(), R_ClassSymbol, Rf_mkString("data.frame"));
+        }
+
+        template <typename T>
+        void push_front( const T& object, const std::string& name){
+            R_xlen_t NewSize = std::max(object.size(), static_cast<R_xlen_t>(nrow()));
+            Parent::push_front(object, name);
+            IntegerVector RowNames = Range(1, NewSize);
+            Rf_setAttrib(Parent::get__(), R_RowNamesSymbol, RowNames);
+            Rf_setAttrib(Parent::get__(), R_ClassSymbol, Rf_mkString("data.frame"));
+        }
+                
         // Offer multiple variants to accomodate both old interface here and signatures in other classes
         inline int nrows() const { return DataFrame_Impl::nrow(); }
         inline int rows()  const { return DataFrame_Impl::nrow(); }

inst/tinytest/cpp/DataFrame.cpp

@@ -94,3 +94,39 @@ IntegerVector DataFrame_nrow( DataFrame df){
 IntegerVector DataFrame_ncol( DataFrame df){
     return IntegerVector::create(df.ncol(), df.cols());
 }
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushBackNamed(){
+    NumericVector u(2);
+    NumericVector v(2);
+    DataFrame df = DataFrame::create(_["u"] = u);
+    df.push_back(v, "v");
+    return df;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushBackUnnamed(){
+    NumericVector u(2);
+    NumericVector v(2);
+    DataFrame df = DataFrame::create(_["u"] = u);
+    df.push_back(v);
+    return df;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushFrontNamed(){
+    NumericVector u(2);
+    NumericVector v(2);
+    DataFrame df = DataFrame::create(_["u"] = u);
+    df.push_front(v, "v");
+    return df;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushFrontUnnamed(){
+    NumericVector u(2);
+    NumericVector v(2);
+    DataFrame df = DataFrame::create(_["u"] = u);
+    df.push_front(v);
+    return df;
+}

inst/tinytest/test_dataframe.R

@@ -70,3 +70,23 @@ expect_equal( DataFrame_nrow( df ), rep(nrow(df), 2) )
 #    test.DataFrame.ncol <- function(){
 df <- data.frame( x = 1:10, y = 1:10 )
 expect_equal( DataFrame_ncol( df ), rep(ncol(df), 2) )
+
+#    test.DataFrame.PushBackNamed <- function(){
+df <- data.frame( u = c(0, 0), v = c(0, 0) )
+expect_true( is.data.frame( DataFrame_PushBackNamed() ) )
+expect_equal( DataFrame_PushBackNamed(), df )
+
+#    test.DataFrame.PushBackUnamed <- function(){
+df <- data.frame( u = c(0, 0), c(0, 0), fix.empty.names = FALSE )
+expect_true( is.data.frame( DataFrame_PushBackUnnamed() ) )
+expect_equal( DataFrame_PushBackUnnamed(), df )
+
+#    test.DataFrame.PushFrontNamed <- function(){
+df <- data.frame( v = c(0, 0), u = c(0, 0) )
+expect_true( is.data.frame( DataFrame_PushFrontNamed() ) )
+expect_equal( DataFrame_PushFrontNamed(), df )
+
+#    test.DataFrame.PushFrontUnnamed <- function(){
+df <- data.frame( c(0, 0), u = c(0, 0), fix.empty.names = FALSE )
+expect_true( is.data.frame( DataFrame_PushFrontUnnamed() ) )
+expect_equal( DataFrame_PushFrontUnnamed(), df )