Implement push_back and push_front for DataFrame.

ChangeLog

@@ -1,3 +1,17 @@
+2020-07-09  Walter Somerville  <waltersom@gmail.com>
+
+	* inst/include/Rcpp/DataFrame.h: Warn when data.frame has varying length
+	* inst/tinyTest/cpp/DataFrame.cpp: Test added
+	* inst/tinyTest/test_dataframe.R: Idem
+
+2020-07-07  Walter Somerville  <waltersom@gmail.com>
+
+	* 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: Idem
+
 2020-07-06  Dirk Eddelbuettel  <edd@debian.org>
 
         * DESCRIPTION (Version, Date): Roll minor version

inst/include/Rcpp/DataFrame.h

@@ -83,6 +83,30 @@ namespace Rcpp{
             return LENGTH(rn);
         }
 
+	template <typename T>
+        void push_back( const T& object){
+            Parent::push_back(object);
+            set_type_after_push();
+        }
+
+        template <typename T>
+        void push_back( const T& object, const std::string& name ){
+            Parent::push_back(object, name);
+            set_type_after_push();
+        }
+
+        template <typename T>
+        void push_front( const T& object){
+            Parent::push_front(object);
+            set_type_after_push();
+        }
+
+        template <typename T>
+        void push_front( const T& object, const std::string& name){
+            Parent::push_front(object, name);
+            set_type_after_push();
+        }
+
         // 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(); }
@@ -106,6 +130,30 @@ namespace Rcpp{
             }
         }
 
+        void set_type_after_push(){
+            int max_rows = 0;
+            bool invalid_column_size = false;
+            SEXP data = Parent::get__();
+            List::iterator it;
+            // Get the maximum number of rows
+            for (it = Parent::begin(); it != Parent::end(); ++it) {
+                if (Rf_xlength(*it) > max_rows) {
+                    max_rows = Rf_xlength(*it);
+                }
+            }
+            for (it = Parent::begin(); it != Parent::end(); ++it) {
+                if (Rf_xlength(*it) == 0 || ( Rf_xlength(*it) > 1 && max_rows % Rf_xlength(*it) != 0 )) {
+                    // We have a column that is not an integer fraction of the largest
+                    invalid_column_size = true;
+                }
+            }
+            if (invalid_column_size) {
+                warning("Column sizes are not equal in DataFrame::push_back, object degrading to List\n");
+            } else {
+                set__(Parent::get__());
+            }
+        }
+
         static DataFrame_Impl from_list( Parent obj ){
             bool use_default_strings_as_factors = true ;
             bool strings_as_factors = true ;

inst/tinytest/cpp/DataFrame.cpp

@@ -94,3 +94,101 @@ 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;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushFrontDataFrame(){
+  NumericVector u(2);
+  NumericVector v(2);
+  NumericVector w(2);
+  NumericVector x(2);
+
+  DataFrame df1 = DataFrame::create(_["u"] = u, _["v"] = v);
+  DataFrame df2 = DataFrame::create(_["w"] = w, _["x"] = x);
+  df1.push_front(df2);
+  return df1;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushBackDataFrame(){
+  NumericVector u(2);
+  NumericVector v(2);
+  NumericVector w(2);
+  NumericVector x(2);
+
+  DataFrame df1 = DataFrame::create(_["u"] = u, _["v"] = v);
+  DataFrame df2 = DataFrame::create(_["w"] = w, _["x"] = x);
+  df1.push_back(df2);
+  return df1;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushWrongSize(){
+  NumericVector u(2);
+  NumericVector v(3);
+
+  DataFrame df1 = DataFrame::create(_["u"] = u);
+  df1.push_back(v);
+  return df1;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushReplicateLength(){
+  NumericVector u(2);
+  NumericVector v(4);
+  NumericVector x(1);
+
+  u[0] = 1;
+  x[0] = 2;
+
+  DataFrame df1 = DataFrame::create(_["u"] = u);
+  df1.push_back(v, "v");
+  df1.push_back(x, "x");
+  return df1;
+}
+
+// [[Rcpp::export]]
+DataFrame DataFrame_PushZeroLength(){
+  NumericVector u(2);
+  NumericVector v(0);
+
+
+  DataFrame df1 = DataFrame::create(_["u"] = u);
+  df1.push_back(v);
+  return df1;
+}

inst/tinytest/test_dataframe.R

@@ -70,3 +70,46 @@ 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) )
+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) )
+expect_true( is.data.frame( DataFrame_PushFrontUnnamed() ) )
+expect_equal( DataFrame_PushFrontUnnamed(), df )
+
+
+#    test.DataFrame.PushFrontDataFrame <- function(){
+df <- data.frame( w = c(0, 0), x = c(0, 0), u = c(0, 0), v = c(0, 0) )
+expect_true( is.data.frame( DataFrame_PushFrontDataFrame() ) )
+expect_equal( DataFrame_PushFrontDataFrame(), df )
+
+#    test.DataFrame.PushBackDataFrame <- function(){
+df <- data.frame( u = c(0, 0), v = c(0, 0), w = c(0, 0), x = c(0, 0) )
+expect_true( is.data.frame( DataFrame_PushBackDataFrame() ) )
+expect_equal( DataFrame_PushBackDataFrame(), df )
+
+#    test.DataFrame.PushWrongSize <- function(){
+df <- data.frame( u = c(0, 0), v = c(0, 0), w = c(0, 0), x = c(0, 0) )
+expect_warning( DataFrame_PushWrongSize() )
+
+#    test.DataFrame.PushReplicateLength <- function(){
+df <- data.frame( u = c(1, 0), v = c(0, 0, 0, 0), x = c(2) )
+expect_true( is.data.frame( DataFrame_PushReplicateLength() ) )
+expect_equal( DataFrame_PushReplicateLength(), df )
+
+#    test.DataFrame.PushZeroLength <- function(){
+expect_warning( DataFrame_PushZeroLength())